home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / UCRASM25.ARJ / FP.ASM < prev    next >
Assembly Source File  |  1991-12-07  |  82KB  |  3,614 lines

  1. ;
  2. StdGrp        group    StdLib, StdData
  3. ;
  4. StdData        segment    para public 'sldata'
  5. ;
  6. ; Floating point package.
  7. ;
  8. ;
  9. ; Released to the public domain
  10. ; Created by: Randall Hyde
  11. ; Date: 8/13/90
  12. ;    8/28/91
  13. ;
  14. ;
  15. ; FP format:
  16. ;
  17. ; 80 bits:
  18. ; bit 79            bit 63                           bit 0
  19. ; |                 |                                    |
  20. ; seeeeeee eeeeeeee mmmmmmmm m...m m...m m...m m...m m...m
  21. ;
  22. ; e = bias 16384 exponent
  23. ; m = 64 bit mantissa with NO implied bit!
  24. ; s = sign (for mantissa)
  25. ;
  26. ;
  27. ; 64 bits:
  28. ; bit 63       bit 51                                               bit 0
  29. ; |            |                                                        |
  30. ; seeeeeee eeeemmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
  31. ;
  32. ; e = bias 1023 exponent.
  33. ; s = sign bit.
  34. ; m = mantissa bits.  Bit 52 is an implied one bit.
  35. ;
  36. ; 32 bits:
  37. ; Bit 31    Bit 22              Bit 0
  38. ; |         |                       |
  39. ; seeeeeee emmmmmmm mmmmmmmm mmmmmmmm
  40. ;
  41. ; e = bias 127 exponent
  42. ; s = sign bit
  43. ; m = mantissa bits, bit 23 is an implied one bit.
  44. ;
  45. ;
  46. ;
  47. ; WARNING: Although this package uses IEEE format floating point numbers,
  48. ;       it is by no means IEEE compliant.  In particular, it does not
  49. ;       support denormalized numbers, special rounding options, and
  50. ;       so on.  Why not?  Two reasons:  I'm lazy and I'm ignorant.
  51. ;       I do not know all the little details surround the IEEE
  52. ;       implementation and I'm not willing to spend more of my life
  53. ;       (than I already have) figuring it out.  There are more
  54. ;       important things to do in life.  Yep, numerical analysts can
  55. ;       rip this stuff to shreads and come up with all kinds of degenerate
  56. ;       cases where this package fails and the IEEE algorithms succeed,
  57. ;       however, such cases are very rare.  One should not get the idea
  58. ;       that IEEE is perfect.  It blows up with lots of degenerate cases
  59. ;       too.  They just designed it so that it handles a few additional
  60. ;       cases that mediocre packages (like this one) do not.  For most
  61. ;       normal computations this package works just fine (what it lacks
  62. ;       it good algorithms it more than makes up for by using an 88-bit
  63. ;       internal format during internal computations).
  64. ;
  65. ;       Moral of the story: If you need highly accurate routines which
  66. ;          produce okay results in the worst of cases, look elsewhere please.
  67. ;       I don't want to be responsible for your blowups.  OTOH, if you need
  68. ;       a fast floating point package which is reasonably accurate and
  69. ;       you're not a statistician, astronomer, or other type for whom
  70. ;       features like denormalized numbers are important, this package
  71. ;       may work out just fine for you.
  72. ;
  73. ;                        Randy Hyde
  74. ;                        August 1990
  75. ;                        (Hard to believe I started this
  76. ;                         a year ago and I'm just coming
  77. ;                         back to it now!)
  78. ;
  79. ;                        UC Riverside &
  80. ;                        Cal Poly Pomona.
  81. ;
  82. ; FPACC- Floating point accumuator.
  83. ; FPOP-  Floating point operand.
  84. ;
  85. ; These variables use the following format:
  86. ;
  87. ; 88 bits:
  88. ; sxxxxxxx eeeeeeee eeeeeeee m..m m..m m..m m..m m..m m..m m..m m..m
  89. ; Sign          exponent                   mantissa (64 bits)
  90. ;
  91. ; Only H.O. bit of Sign byte is significant.  The rest is garbage.
  92. ; Exponent is bias 32767 exponent.
  93. ; Mantissa does NOT have an implied one bit.
  94. ;
  95. ; This format was picked for convenience (it is easy to work with) and it
  96. ; exceeds the 80-bit format used by Intel on the 80x87 chips.
  97. ;
  98. fptype        struc
  99. Mantissa    dw    4 dup (?)
  100. Exponent    dw    ?
  101. Sign        db    ?
  102.         db    ?        ;Padding
  103. fptype        ends
  104. ;
  105. ;
  106. ;
  107. ;
  108.         public    fpacc
  109. fpacc        fptype    <>
  110. ;
  111.         public    fpop
  112. fpop        fptype  <>
  113. ;
  114. ;
  115. ; FProd- Holds 144-bit result obtained by multiplying fpacc.mant x fpop.mant
  116. ;
  117. Quotient    equ    this word
  118. fprod        dw    9 dup (?)
  119. ;
  120. ;
  121. ; Variables used by the floating point I/O routines:
  122. ;
  123. TempExp        dw    ?
  124. ExpSign        db    ?
  125. DecExponent    dw    ?
  126. DecSign        db    0
  127. DecDigits    db    31 dup (?)
  128. ;
  129. ;
  130. ;
  131. StdData        ends
  132. ;
  133. ;
  134. stdlib        segment    para public 'slcode'
  135.         assume    cs:stdgrp, ds:nothing, es:nothing, ss:nothing
  136. ;
  137. ;
  138. ;
  139. ;
  140. ;
  141. ;
  142. ;
  143. ;
  144. ;
  145. ;
  146. ;---------------------------------------------------------------------------
  147. ;        Floating Point Load/Store Routines
  148. ;---------------------------------------------------------------------------
  149. ;
  150. ; sl_AccOp    Copies the floating point accumulator to the floating point
  151. ;        operand.
  152. ;
  153.         public    sl_AccOp
  154. sl_AccOp    proc    far
  155.         assume    ds:StdGrp
  156.         push    ax
  157.         push    ds
  158.         mov    ax, StdGrp
  159.         mov    ds, ax
  160. ;
  161.         mov    ax, FPacc.Exponent
  162.         mov    FPop.Exponent, ax
  163.         mov    ax, FPacc.Mantissa
  164.         mov    FPop.Mantissa, ax
  165.         mov    ax, FPacc.Mantissa+2
  166.         mov    FPop.Mantissa+2, ax
  167.         mov    ax, FPacc.Mantissa+4
  168.         mov    FPop.Mantissa+4, ax
  169.         mov    ax, FPacc.Mantissa+6
  170.         mov    FPop.Mantissa+6, ax
  171.         mov    al, Fpacc.Sign
  172.         mov    FPop.Sign, al
  173. ;
  174.         pop    ds
  175.         pop    ax
  176.         ret
  177. sl_AccOp    endp
  178.         assume    ds:nothing
  179. ;
  180. ;
  181. ; sl_XAccOp-    Exchanges the values in the floating point accumulator
  182. ;        and floating point operand.
  183. ;
  184.         public    sl_XAccOp
  185. sl_XAccOp    proc    far
  186.         assume    ds:StdGrp
  187.         push    ax
  188.         push    ds
  189.         mov    ax, StdGrp
  190.         mov    ds, ax
  191. ;
  192.         mov    ax, FPacc.Exponent
  193.         xchg    ax, FPop.Exponent
  194.         mov    FPacc.Exponent, ax
  195. ;
  196.         mov    ax, FPacc.Mantissa
  197.         xchg    ax, FPop.Mantissa
  198.         mov    FPacc.Mantissa, ax
  199. ;
  200.         mov    ax, FPacc.Mantissa+2
  201.         xchg    ax, FPop.Mantissa+2
  202.         mov    FPacc.Mantissa+2, ax
  203. ;
  204.         mov    ax, FPacc.Mantissa+4
  205.         xchg    ax, FPop.Mantissa+4
  206.         mov    FPacc.Mantissa+4, ax
  207. ;
  208.         mov    ax, FPacc.Mantissa+6
  209.         xchg    ax, FPop.Mantissa+6
  210.         mov    FPacc.Mantissa+6, ax
  211. ;
  212.         mov    al, FPacc.Sign
  213.         xchg    al, FPop.Sign
  214.         mov    FPacc.Sign, al
  215. ;
  216.         pop    ds
  217.         pop    ax
  218.         ret
  219. sl_XAccOp    endp
  220.         assume    ds:nothing
  221. ;
  222. ;
  223. ;
  224. ; sl_LSFPA-     Loads a single precision (32-bit) IEEE format number into
  225. ;        the floating point accumulator.  ES:DI points at the # to
  226. ;        load into FPACC.
  227. ;
  228.         public    sl_LSFPA
  229. sl_LSFPA    proc    far
  230.         push    ax
  231.         push    bx
  232.         mov    ax, es:[di]
  233.         mov    word ptr StdGrp:fpacc.mantissa[5], ax
  234.         mov    ax, es:2[di]
  235.         mov    bx, ax
  236.         shl    ax, 1
  237.         mov    al, ah
  238.         mov    ah, 0
  239.         add    ax, 32767-127        ;Adjust exponent bias.
  240.         mov    word ptr StdGrp:fpacc.exponent, ax
  241.         mov    StdGrp:fpacc.sign, bh    ;Save sign away.
  242.         mov    al, es:2[di]
  243.         and    al, 7fh            ;Strip out L.O. exp bit.
  244.         or    al, 80h            ;Add in implied bit.
  245.         mov    byte ptr StdGrp:fpacc.mantissa[7], al ;Save H.O. mant byte.
  246.         xor    ax, ax
  247.         mov    word ptr StdGrp:fpacc.mantissa, ax
  248.         mov    word ptr StdGrp:fpacc.mantissa[2], ax
  249.         mov    byte ptr StdGrp:fpacc.mantissa[4], al
  250.         pop    bx
  251.         pop    ax
  252.         ret
  253. sl_LSFPA    endp
  254. ;
  255. ;
  256. ;
  257. ;
  258. ; sl_SSFPA-    Stores FPACC into the single precision variable pointed at by
  259. ;        ES:DI.  Performs appropriate rounding.  Returns carry clear
  260. ;        if the operation is successful, returns carry set if FPACC
  261. ;        cannot fit into a single precision variable.
  262. ;
  263.         public    sl_SSFPA
  264. sl_SSFPA    proc    far
  265.         assume    ds:stdgrp
  266.         push    ds
  267.         push    ax
  268.         push    bx
  269.         mov    ax, StdGrp
  270.         mov    ds, ax
  271.         push    fpacc.Exponent
  272.         push    fpacc.Mantissa       ;Save the stuff we tweak
  273.         push    fpacc.Mantissa[2]    ; so that this operation
  274.         push    fpacc.Mantissa[4]    ; will be non-destructive.
  275.         push    fpacc.Mantissa[6]
  276. ;
  277. ; First, round FPACC:
  278. ;
  279.         add    fpacc.Mantissa [4], 80h
  280.         adc    fpacc.Mantissa [6], 0
  281.         jnc    StoreAway
  282.         rcl    fpacc.Mantissa [6], 1
  283.         rcl    fpacc.Mantissa [4], 1
  284.         inc    fpacc.Exponent
  285.         jz    BadSSFPA        ;If exp overflows.
  286. ;
  287. ; Store the value away:
  288. ;
  289. StoreAway:    mov    ax, fpacc.Exponent
  290.         sub    ax, 32767-127        ;Convert to bias 127
  291.         cmp    ah, 0
  292.         jne    BadSSFPA
  293.         mov    bl, fpacc.Sign
  294.         shl    bl, 1            ;Merge in the sign bit.
  295.         rcr    al, 1
  296.         mov    es:[di] + 3, al        ;Save away exponent/sign
  297.         pushf                ;Save bit shifted out.
  298.         mov    ax, fpacc.Mantissa [6]
  299.         shl    ax, 1            ;Get rid of implied bit and
  300.         popf                ; shift in the L.O. exponent
  301.         rcr    ax, 1            ; bit.
  302.         mov    es:[di] + 1, ax
  303.         mov    al, byte ptr fpacc.Mantissa [5]
  304.         mov    es:[di], al
  305.         clc
  306.         jmp    SSFPADone
  307. ;
  308. BadSSFPA:    stc
  309. SSFPADone:    pop    fpacc.Mantissa[6]
  310.         pop    fpacc.Mantissa[4]
  311.         pop    fpacc.Mantissa[2]
  312.         pop    fpacc.Mantissa
  313.         pop    fpacc.Exponent
  314.         pop    bx
  315.         pop    ax
  316.         pop    ds
  317.         ret
  318.         assume    ds:nothing
  319. sl_SSFPA    endp
  320. ;
  321. ;
  322. ; sl_LDFPA-    Loads the double precision (64-bit) IEEE format number pointed
  323. ;        at by ES:DI into FPACC.
  324. ;
  325.         public    sl_LDFPA
  326. sl_LDFPA    proc    far
  327.         push    ax
  328.         push    bx
  329.         push    cx
  330.         mov    ax, es:6[di]
  331.         mov    StdGrp:fpacc.sign, ah    ;Save sign bit.
  332.         mov    cl, 4
  333.         shr    ax, cl            ;Align exponent field.
  334.         and    ah, 111b        ;Strip the sign bit.
  335.         add    ax, 32767-1023        ;Adjust bias
  336.         mov    StdGrp:fpacc.exponent, ax
  337. ;
  338. ; Get the mantissa bits and left justify them in the FPACC.
  339. ;
  340.         mov    ax, es:5[di]
  341.         and    ax, 0fffh        ;Strip exponent bits.
  342.         or    ah, 10h            ;Add in implied bit.
  343.         mov    cl, 3
  344.         shl    ax, cl
  345.         mov    bx, es:3[di]
  346.         rol    bx, cl
  347.         mov    ch, bl
  348.         and    ch, 7
  349.         or    al, ch
  350.         mov    StdGrp:fpacc.mantissa[6], ax
  351. ;
  352.         and    bl, 0f8h
  353.         mov    ax, es:1[di]
  354.         rol    ax, cl
  355.         mov    ch, al
  356.         and    ch, 7
  357.         or    bl, ch
  358.         mov    StdGrp:fpacc.mantissa[4], bx
  359. ;
  360.         and    al, 0f8h
  361.         mov    bh, es:[di]
  362.         rol    bh, cl
  363.         mov    ch, bh
  364.         and    ch, 7
  365.         or    al, ch
  366.         mov    StdGrp:fpacc.mantissa[2], ax
  367.         and    bh, 0f8h
  368.         mov    bl, 0
  369.         mov    StdGrp:fpacc.Mantissa[0], bx
  370. ;
  371.         pop    cx
  372.         pop    bx
  373.         pop    ax
  374.         ret
  375. sl_LDFPA    endp
  376. ;
  377. ;
  378. ;
  379. ;
  380. ; sl_SDFPA-    Stores FPACC into the double precision variable pointed
  381. ;        at by ES:DI.
  382. ;
  383.         public    sl_sdfpa
  384. sl_SDFPA    proc    far
  385.         assume    ds:stdgrp
  386.         push    ds
  387.         push    ax
  388.         push    bx
  389.         push    cx
  390.         push    dx
  391.         push    di
  392. ;
  393.         mov    bx, StdGrp
  394.         mov    ds, bx
  395. ;
  396.         push    fpacc.Mantissa [0]
  397.         push    fpacc.Mantissa [2]
  398.         push    fpacc.Mantissa [4]
  399.         push    fpacc.Mantissa [6]
  400.         push    fpacc.Exponent
  401. ;
  402. ; First, round this guy to 52 bits:
  403. ;
  404.         add    byte ptr fpacc.Mantissa [1], 8
  405.         jnc    SkipRndUp
  406.         inc    fpacc.Mantissa [2]
  407.         jnz    SkipRndUp
  408.         inc    fpacc.Mantissa [4]
  409.         jnz    SkipRndUp
  410.         inc    fpacc.Mantissa [6]
  411.         jnz    SkipRndUp
  412. ;
  413. ; Whoops!  Got an overflow, fix that here:
  414. ;
  415.         stc
  416.         rcr    fpacc.Mantissa [6], 1
  417.         rcr    fpacc.Mantissa [4], 1
  418.         rcr    fpacc.Mantissa [2], 1
  419.         rcr    byte ptr fpacc.Mantissa [1], 1
  420.         inc    fpacc.Exponent
  421.         jz    BadSDFPA        ;In case exp was really big.
  422. ;
  423. ; Okay, adjust and store the exponent-
  424. ;
  425. SkipRndUp:    mov    ax, fpacc.Exponent
  426.         sub    ax, 32767-1023        ;Adjust bias
  427.         cmp    ax, 2048        ;Make sure the value will still
  428.         jae    BadSDFPA        ; fit in an 8-byte real.
  429.         mov    cl, 5
  430.         shl    ax, cl            ;Move exponent into place.
  431.         mov    bl, fpacc.Sign
  432.         shl    bl, 1
  433.         rcr    ax, 1            ;Merge in sign bit.
  434. ;
  435. ; Merge in the upper four bits of the Mantissa (don't forget that the H.O.
  436. ; Mantissa bit is lost due to the implied one bit).
  437. ;
  438.         mov    bl, byte ptr fpacc.Mantissa [7]
  439.         shr    bl, 1
  440.         shr    bl, 1
  441.         shr    bl, 1
  442.         and    bl, 0fh            ;Strip away H.O. mant bit.
  443.         or    al, bl
  444.         mov    es:[di]+6, ax        ;Store away H.O. word.
  445. ;
  446. ; Okay, now adjust and store away the rest of the mantissa:
  447. ;
  448.         mov    ax, fpacc.Mantissa [0]
  449.         mov    bx, fpacc.Mantissa [2]
  450.         mov    cx, fpacc.Mantissa [4]
  451.         mov    dx, fpacc.Mantissa [6]
  452. ;
  453. ; Shift the bits to their appropriate places (to the left five bits):
  454. ;
  455.         shl    ax, 1
  456.         rcl    bx, 1
  457.         rcl    cx, 1
  458.         rcl    dx, 1
  459. ;
  460.         shl    ax, 1
  461.         rcl    bx, 1
  462.         rcl    cx, 1
  463.         rcl    dx, 1
  464. ;
  465.         shl    ax, 1
  466.         rcl    bx, 1
  467.         rcl    cx, 1
  468.         rcl    dx, 1
  469. ;
  470.         shl    ax, 1
  471.         rcl    bx, 1
  472.         rcl    cx, 1
  473.         rcl    dx, 1
  474. ;
  475.         shl    ax, 1
  476.         rcl    bx, 1
  477.         rcl    cx, 1
  478.         rcl    dx, 1
  479. ;
  480. ; Store away the results:
  481. ;
  482.         mov    es:[di], bx
  483.         mov    es:[di] + 2, cx
  484.         mov    es: [di] + 4, dx
  485. ;
  486. ; Okay, we're done.  Return carry clear to denote success.
  487. ;
  488.         clc
  489.         jmp    short QuitSDFPA
  490. ;
  491. BadSDFPA:    stc                ;If an error occurred.
  492. QuitSDFPA:    pop    fpacc.Exponent
  493.         pop    fpacc.Mantissa [6]
  494.         pop    fpacc.Mantissa [4]
  495.         pop    fpacc.Mantissa [2]
  496.         pop    fpacc.Mantissa [0]
  497.         pop    di
  498.         pop    dx
  499.         pop    cx
  500.         pop    bx
  501.         pop    ax
  502.         pop    ds
  503.         ret
  504. ;
  505.         assume    ds:nothing
  506. sl_SDFPA    endp
  507. ;
  508. ;
  509. ;
  510. ;
  511. ; sl_LEFPA-    Loads an extended precision (80-bit) IEEE format number
  512. ;        into the floating point accumulator.  ES:DI points at the
  513. ;        number to load into FPACC.
  514. ;
  515.         public    sl_LEFPA
  516. sl_LEFPA    proc    far
  517.         push    ax
  518.         mov    ax, es:8[di]
  519.         mov    StdGrp:fpacc.Sign, ah
  520.         and     ah, 7fh
  521.         add    ax, 4000h
  522.         mov    StdGrp:fpacc.Exponent, ax
  523.         mov    ax, es:[di]
  524.         mov    StdGrp:fpacc.Mantissa, ax
  525.         mov    ax, es:2[di]
  526.         mov    StdGrp:fpacc.Mantissa[2], ax
  527.         mov    ax, es:4[di]
  528.         mov    StdGrp:fpacc.Mantissa[4], ax
  529.         mov    ax, es:6[di]
  530.         mov    StdGrp:fpacc.Mantissa[6], ax
  531.         pop    ax
  532.         ret
  533. sl_LEFPA    endp
  534. ;
  535. ;
  536. ; sl_LEFPAL-    Loads an extended precision (80-bit) IEEE format number
  537. ;        into the floating point accumulator.  The number to load
  538. ;        into FPACC follows the call in the code stream.
  539. ;
  540.         public    sl_LEFPAL
  541. sl_LEFPAL    proc    far
  542.         push    bp
  543.         mov    bp, sp
  544.         push    es
  545.         push    di
  546.         push    ax
  547.         les    di, 2[bp]
  548. ;
  549.         mov    ax, es:8[di]
  550.         mov    StdGrp:fpacc.Sign, ah
  551.         and     ah, 7fh
  552.         add    ax, 4000h
  553.         mov    StdGrp:fpacc.Exponent, ax
  554.         mov    ax, es:[di]
  555.         mov    StdGrp:fpacc.Mantissa, ax
  556.         mov    ax, es:2[di]
  557.         mov    StdGrp:fpacc.Mantissa[2], ax
  558.         mov    ax, es:4[di]
  559.         mov    StdGrp:fpacc.Mantissa[4], ax
  560.         mov    ax, es:6[di]
  561.         mov    StdGrp:fpacc.Mantissa[6], ax
  562. ;
  563. ; Adjust the return address to point past the floating point number we
  564. ; just loaded.
  565. ;
  566.         add    word ptr 2[bp], 10
  567. ;
  568.         pop    ax
  569.         pop    di
  570.         pop    es
  571.         pop    bp
  572.         ret
  573. sl_LEFPAL    endp
  574. ;
  575. ;
  576. ; sl_SEFPA-    Stores FPACC into in the extended precision variable
  577. ;        pointed at by ES:DI.
  578. ;
  579.         public    sl_sefpa
  580. sl_SEFPA    proc    far
  581.         assume    ds:stdgrp
  582.         push    ds
  583.         push    ax
  584.         mov    ax, StdGrp
  585.         mov    ds, ax
  586.         push    fpacc.Mantissa [0]
  587.         push    fpacc.Mantissa [2]
  588.         push    fpacc.Mantissa [4]
  589.         push    fpacc.Mantissa [6]
  590.         push    fpacc.Exponent
  591. ;
  592.         mov    ax, fpacc.Exponent
  593.         sub    ax, 4000h
  594.         cmp    ax, 8000h
  595.         jae    BadSEFPA
  596.         test    fpacc.Sign, 80h
  597.         jz    StoreSEFPA
  598.         or    ah, 80h
  599. StoreSEFPA:    mov    es:[di]+8, ax
  600.         mov    ax, fpacc.Mantissa [0]
  601.         mov    es:[di], ax
  602.         mov    ax, fpacc.Mantissa [2]
  603.         mov    es:[di] + 2, ax
  604.         mov    ax, fpacc.Mantissa [4]
  605.         mov    es:[di] + 4, ax
  606.         mov    ax, fpacc.Mantissa [6]
  607.         mov    es:[di] + 6, ax
  608.         clc
  609.         jmp    SEFPADone
  610. ;
  611. BadSEFPA:    stc
  612. SEFPADone:    pop    fpacc.Exponent
  613.         pop    fpacc.Mantissa[6]
  614.         pop    fpacc.Mantissa[4]
  615.         pop    fpacc.Mantissa[2]
  616.         pop    fpacc.Mantissa[0]
  617.         pop    ax
  618.         pop    ds
  619.         ret
  620.         assume    ds:nothing
  621. sl_SEFPA        endp
  622. ;
  623. ;
  624. ;
  625. ; sl_LSFPO-     Loads a single precision (32-bit) IEEE format number into
  626. ;        the floating point operand.  ES:DI points at the # to
  627. ;        load into FPOP.
  628. ;
  629.         public    sl_LSFPO
  630. sl_LSFPO    proc    far
  631.         push    ax
  632.         push    bx
  633.         mov    ax, es:[di]
  634.         mov    word ptr StdGrp:fpop.mantissa[5], ax
  635.         mov    ax, es:2[di]
  636.         mov    bx, ax
  637.         shl    ax, 1
  638.         mov    al, ah
  639.         mov    ah, 0
  640.         add    ax, 32767-127        ;Adjust exponent bias.
  641.         mov    word ptr StdGrp:fpop.exponent, ax
  642.         mov    StdGrp:fpop.sign, bh    ;Save sign away.
  643.         mov    al, ds:2[di]
  644.         and    al, 7fh            ;Strip out L.O. exp bit.
  645.         or    al, 80h            ;Add in implied bit.
  646.         mov    byte ptr StdGrp:fpop.mantissa[7], al
  647.         xor    ax, ax
  648.         mov    word ptr StdGrp:fpop.mantissa, ax
  649.         mov    word ptr StdGrp:fpop.mantissa[2], ax
  650.         mov    byte ptr StdGrp:fpop.mantissa[4], al
  651.         pop    bx
  652.         pop    ax
  653.         ret
  654. sl_LSFPO    endp
  655. ;
  656. ;
  657. ;
  658. ;
  659. ;
  660. ; sl_LDFPO-    Loads the double precision (64-bit) IEEE format number pointed
  661. ;        at by ES:DI into FPOP.
  662. ;
  663.         public    sl_LDFPO
  664. sl_LDFPO    proc    far
  665.         push    ax
  666.         push    bx
  667.         push    cx
  668.         mov    ax, es:6[di]
  669.         mov    StdGrp:fpop.sign, ah    ;Save sign bit.
  670.         mov    cl, 4
  671.         shr    ax, cl            ;Align exponent field.
  672.         and    ah, 111b        ;Strip the sign bit.
  673.         add    ax, 32767-1023        ;Adjust bias
  674.         mov    word ptr StdGrp:fpop.exponent, ax
  675. ;
  676. ; Get the mantissa bits and left justify them in the FPOP.
  677. ;
  678.         mov    ax, es:5[di]
  679.         and    ax, 0fffh        ;Strip exponent bits.
  680.         or    ah, 10h            ;Add in implied bit.
  681.         mov    cl, 3
  682.         shl    ax, cl
  683.         mov    bx, es:3[di]
  684.         rol    bx, cl
  685.         mov    ch, bl
  686.         and    ch, 7
  687.         or    al, ch
  688.         mov    word ptr StdGrp:fpop.mantissa[6], ax
  689. ;
  690.         and    bl, 0f8h
  691.         mov    ax, es:1[di]
  692.         rol    ax, cl
  693.         mov    ch, al
  694.         and    ch, 7
  695.         or    bl, ch
  696.         mov    word ptr StdGrp:fpop.mantissa[4], bx
  697. ;
  698.         and    al, 0f8h
  699.         mov    bh, es:[di]
  700.         rol    bh, cl
  701.         mov    ch, bh
  702.         and    ch, 7
  703.         or    al, ch
  704.         mov    word ptr StdGrp:fpop.mantissa[2], ax
  705.         and    bh, 0f8h
  706.         mov    bl, 0
  707.         mov    word ptr StdGrp:fpop.Mantissa[0], bx
  708. ;
  709.         pop    cx
  710.         pop    bx
  711.         pop    ax
  712.         ret
  713. sl_LDFPO    endp
  714. ;
  715. ;
  716. ;
  717. ;
  718. ;
  719. ; sl_LEFPO-    Loads an extended precision (80-bit) IEEE format number
  720. ;        into the floating point operand.  ES:DI points at the
  721. ;        number to load into FPACC.
  722. ;
  723.         public    sl_LEFPO
  724. sl_LEFPO    proc    far
  725.         push    ax
  726.         mov    ax, es:8[di]
  727.         mov    StdGrp:fpop.Sign, ah
  728.         and     ah, 7fh
  729.         add    ax, 4000h
  730.         mov    StdGrp:fpop.Exponent, ax
  731.         mov    ax, es:[di]
  732.         mov    StdGrp:fpop.Mantissa, ax
  733.         mov    ax, es:2[di]
  734.         mov    StdGrp:fpop.Mantissa[2], ax
  735.         mov    ax, es:4[di]
  736.         mov    StdGrp:fpop.Mantissa[4], ax
  737.         mov    ax, es:6[di]
  738.         mov    StdGrp:fpop.Mantissa[6], ax
  739.         pop    ax
  740.         ret
  741. sl_LEFPO    endp
  742. ;
  743. ;
  744. ;
  745. ;
  746. ; sl_LEFPOL-    Loads an extended precision (80-bit) IEEE format number
  747. ;        into the floating point operand.  The number to load
  748. ;        follows the call instruction in the code stream.
  749. ;
  750.         public    sl_LEFPOL
  751. sl_LEFPOL    proc    far
  752.         push    bp
  753.         mov    bp, sp
  754.         push    es
  755.         push    di
  756.         push    ax
  757.         les    di, 2[bp]
  758. ;
  759.         mov    ax, es:8[di]
  760.         mov    StdGrp:fpop.Sign, ah
  761.         and     ah, 7fh
  762.         add    ax, 4000h
  763.         mov    StdGrp:fpop.Exponent, ax
  764.         mov    ax, es:[di]
  765.         mov    StdGrp:fpop.Mantissa, ax
  766.         mov    ax, es:2[di]
  767.         mov    StdGrp:fpop.Mantissa[2], ax
  768.         mov    ax, es:4[di]
  769.         mov    StdGrp:fpop.Mantissa[4], ax
  770.         mov    ax, es:6[di]
  771.         mov    StdGrp:fpop.Mantissa[6], ax
  772. ;
  773.         add    word ptr 2[bp], 10    ;Skip rtn adrs past #.
  774. ;
  775.         pop    ax
  776.         pop    di
  777.         pop    es
  778.         pop    bp
  779.         ret
  780. sl_LEFPOL    endp
  781. ;
  782. ;
  783. ;
  784. ;
  785. ;
  786. ;
  787. ;
  788. ;--------------------------------------------------------------------------
  789. ;         Integer <=> FP Conversions
  790. ;--------------------------------------------------------------------------
  791. ;
  792. ;
  793. ;
  794. ; ITOF-        Converts 16-bit signed value in AX to a floating point value
  795. ;        in FPACC.
  796. ;
  797.         public    sl_itof
  798. sl_itof        proc    far
  799.         assume    ds:stdgrp
  800.         push    ds
  801.         push    ax
  802.         push    cx
  803.         mov    cx, StdGrp
  804.         mov    ds, cx
  805. ;
  806.         mov    cx, 800Fh        ;Magic exponent value (65536).
  807. ;
  808. ; Set the sign of the result:
  809. ;
  810.         mov    fpacc.Sign, 0        ;Assume a positive value.
  811.         or    ax, ax            ;Special case for zero!
  812.         jz    SetFPACC0
  813.         jns    DoUTOF            ;Take care of neg values.
  814.         mov    fpacc.sign, 80h        ;This guy is negative!
  815.         neg    ax            ;Work with abs(AX).
  816.         jmp    DoUTOF
  817. sl_ITOF        endp
  818. ;
  819. ;
  820. ; UTOF-        Like ITOF above except this guy works for unsigned 16-bit
  821. ;        integer values.
  822. ;
  823.         public    sl_utof
  824. sl_UTOF        proc    far
  825.         push    ds
  826.         push    ax
  827.         push    cx
  828. ;
  829. ;
  830.         mov    cx, StdGrp
  831.         mov    ds, cx
  832.         mov    cx, 800Fh        ;Magic exponent value (65536).
  833.         or    ax, ax
  834.         jz    SetFPACC0
  835.         mov    fpacc.Sign, 0
  836. ;
  837. sl_UTOF        endp
  838. ;
  839. ;
  840. ; Okay, convert the number to a floating point value:
  841. ; Remember, we need to end up with a normalized number (one where the H.O.
  842. ; bit of the mantissa contains a one).  The largest possible value (65535 or
  843. ; 0FFFFh) is equal to 800E FFFF 0000 0000 0000.  All other values have an
  844. ; exponent less than or equal to 800Eh.  If the H.O. bit of the value is
  845. ; not one, we must shift it to the left and dec the exp by 1.  E.g., if AX
  846. ; contains 1, then we will need to shift it 15 times to normalize the value,
  847. ; decrementing the exponent each time produces 7fffh which is the proper
  848. ; exponent for "1".
  849. ;
  850. ; Note: this is not a proc!  Making it a proc makes it incompatible with
  851. ; one or more different assemblers (TASM, OPTASM, MASM6).
  852. ; Besides, this has to be a near label with a far return!
  853. ;
  854. DoUTOF:
  855. UTOFWhlPos:    dec    cx
  856.         shl    ax, 1
  857.         jnc    UTOFWhlPos
  858.         rcr    ax, 1            ;Put bit back.
  859.         mov    fpacc.Exponent, cx    ;Save exponent value.
  860.         mov    fpacc.Mantissa [6], ax    ;Save Mantissa value.
  861.         xor    ax, ax
  862.         mov    fpacc.Mantissa [4], ax    ;Zero out the rest of the
  863.         mov    fpacc.Mantissa [2], ax    ; mantissa.
  864.         mov    fpacc.Mantissa [0], ax
  865.         jmp     UTOFDone
  866. ;
  867. ; Special case for zero, must zero all bytes in FPACC.  Note that AX already
  868. ; contains zero.
  869. ;
  870. SetFPACC0:    mov    fpacc.Exponent, ax
  871.         mov    fpacc.Mantissa [6], ax
  872.         mov    fpacc.Mantissa [4], ax
  873.         mov    fpacc.Mantissa [2], ax
  874.         mov    fpacc.Mantissa [0], ax
  875.         mov    fpacc.Sign, al
  876. ;
  877. UTOFDone:    pop    cx
  878.         pop    ax
  879.         pop    ds
  880.         retf
  881. ;
  882. ;
  883. ;
  884. ;
  885. ;
  886. ;
  887. ; LTOF-        Converts 32-bit signed value in DX:AX to a floating point
  888. ;        value in FPACC.
  889. ;
  890.         public    sl_ltof
  891. sl_ltof        proc    far
  892.         assume    ds:stdgrp
  893.         push    ds
  894.         push    ax
  895.         push    cx
  896.         push    dx
  897.         mov    cx, StdGrp
  898.         mov    ds, cx
  899. ;
  900. ; Set the sign of the result:
  901. ;
  902.         mov    fpacc.Sign, 0        ;Assumed a positive value.
  903.         mov    cx, dx
  904.         or    cx, ax
  905.         jz    SetUL0
  906.         or    dx, dx            ;Special case for zero!
  907.         jns    DoULTOF            ;Take care of neg values.
  908.         mov    fpacc.sign, 80h        ;This guy is negative!
  909.         neg    dx            ;Do a 32-bit NEG operation
  910.         neg    ax            ; (yes, this really does
  911.         sbb    dx, 0            ;  work!).
  912.         jmp    DoULTOF
  913. sl_LTOF        endp
  914. ;
  915. ;
  916. ; ULTOF-    Like LTOF above except this guy works for unsigned 32-bit
  917. ;        integer values.
  918. ;
  919.         public    sl_ultof
  920. sl_ULTOF    proc    far
  921.         push    ds
  922.         push    ax
  923.         push    cx
  924.         push    dx
  925. ;
  926.         mov    cx, StdGrp
  927.         mov    ds, cx
  928. ;
  929.         mov    cx, dx
  930.         or    cx, ax
  931.         jz    SetUL0
  932.         mov    fpacc.Sign, 0
  933. ;
  934. sl_ULTOF        endp
  935. ;
  936. ;
  937. ;
  938. DoULTOF:
  939.         mov    cx, 801Fh        ;Magic exponent value (65536).
  940. ULTOFWhlPos:    dec    cx
  941.         shl    ax, 1
  942.         rcl    dx, 1
  943.         jnc    ULTOFWhlPos
  944.         rcr    dx, 1            ;Put bit back.
  945.         rcr    ax, 1
  946.         mov    fpacc.Exponent, cx    ;Save exponent value.
  947.         mov    fpacc.Mantissa [6], dx    ;Save Mantissa value.
  948.         mov    fpacc.Mantissa [4], ax
  949.         xor    ax, ax            ;Zero out the rest of the
  950.         mov    fpacc.Mantissa [2], ax    ; mantissa.
  951.         mov    fpacc.Mantissa [0], ax
  952.         jmp     ULTOFDone
  953. ;
  954. ; Special case for zero, must zero all bytes in FPACC.  Note that AX already
  955. ; contains zero.
  956. ;
  957. SetUL0:        mov    fpacc.Exponent, ax
  958.         mov    fpacc.Mantissa [6], ax
  959.         mov    fpacc.Mantissa [4], ax
  960.         mov    fpacc.Mantissa [2], ax
  961.         mov    fpacc.Mantissa [0], ax
  962.         mov    fpacc.Sign, al
  963. ;
  964. ULTOFDone:    pop    dx
  965.         pop    cx
  966.         pop    ax
  967.         pop    ds
  968.         retf
  969. ;
  970. ;
  971. ;
  972. ;
  973. ; FTOI- Converts the floating point value in FPACC to a signed 16-bit
  974. ;    integer and returns this integer in AX.
  975. ;    Returns carry set if the number is too big to fit into AX.
  976. ;
  977.         public    sl_FTOI
  978. sl_FTOI        proc    far
  979.         assume    ds:stdgrp
  980.         push    ds
  981.         push    cx
  982.         mov    cx, StdGrp
  983.         mov    ds, cx
  984. ;
  985.         mov    cx, fpacc.Exponent
  986.         cmp    cx, 800eh
  987.         jb    FTOIok
  988. ;
  989. ; Handle special case of -32768:
  990. ;
  991.         call    DoFToU
  992.         cmp    ax, 8000h
  993.         je    FtoiOk2
  994.         stc
  995.         jmp    TooBig
  996. ;
  997. FTOIok:        call    DoFTOU
  998. FtoiOk2:    cmp    fpacc.Sign, 0
  999.         jns    FTOIJustRight
  1000.         neg    ax
  1001. FTOIJustRight:    clc
  1002. TooBig:        pop    cx
  1003.         pop    ds
  1004.         ret
  1005. sl_FTOI        endp
  1006. ;
  1007. ;
  1008. ;
  1009. ;
  1010. ; FTOU- Like FTOI above, except this guy converts a floating point value
  1011. ;     to an unsigned integer in AX.
  1012. ;    Returns carry set if out of range (including negative numbers).
  1013. ;
  1014.         public    sl_FTOU
  1015. sl_FTOU        proc    far
  1016.         assume    ds:stdgrp
  1017.         push    ds
  1018.         push    cx
  1019.         mov    cx, StdGrp
  1020.         mov    ds, cx
  1021. ;
  1022.         mov    cx, fpacc.Exponent
  1023.         cmp    cx, 800fh
  1024.         jb    FTOUok
  1025. BadU:        stc
  1026.         jmp    UTooBig
  1027. ;
  1028. FTOUok:        call    DoFTOU
  1029.         cmp    fpacc.Sign, 0
  1030.         js    BadU
  1031. ;
  1032. FTOUJustRight:    clc
  1033. UTooBig:    pop    cx
  1034.         pop    ds
  1035.         ret
  1036. sl_FTOU        endp
  1037. ;
  1038. ;
  1039. ; DoFTOU- This code does the actual conversion!
  1040. ;
  1041. DoFTOU        proc    near
  1042.         mov    ax, fpacc.Mantissa [6]
  1043.         cmp    cx, 7fffh
  1044.         jb    SetFTOU0
  1045.         sub    cx, 800eh
  1046.         neg    cx
  1047.         shr    ax, cl
  1048.         ret
  1049. ;
  1050. SetFTOU0:    xor    ax, ax
  1051.         ret
  1052. DoFTOU        endp
  1053. ;
  1054. ;
  1055. ;
  1056. ;
  1057. ;
  1058. ; FTOL- Converts the floating point value in FPACC to a signed 32-bit
  1059. ;    integer and returns this integer in DX:AX.
  1060. ;    Returns carry set if the number is too big to fit into DX:AX.
  1061. ;
  1062.         public    sl_FTOL
  1063. sl_FTOL        proc    far
  1064.         assume    ds:StdGrp
  1065.         push    ds
  1066.         push    cx
  1067.         mov    cx, StdGrp
  1068.         mov    ds, cx
  1069. ;
  1070.         mov    cx, fpacc.Exponent
  1071.         cmp    cx, 801eh
  1072.         jb    FTOLok
  1073.         stc
  1074.         jmp    LTooBig
  1075. ;
  1076. FTOLok:        call    DoFTOUL
  1077.         cmp    fpacc.Sign, 0
  1078.         jns    FTOLJustRight
  1079.         neg    dx            ;32-bit negate operation.
  1080.         neg    ax
  1081.         sbb    dx, 0
  1082. FTOLJustRight:    clc
  1083. LTooBig:    pop    cx
  1084.         pop    ds
  1085.         ret
  1086. sl_FTOL        endp
  1087. ;
  1088. ;
  1089. ;
  1090. ;
  1091. ; FTOUL-Like FTOL above, except this guy converts a floating point value
  1092. ;     to a 32-bit unsigned integer in DX:AX.
  1093. ;    Returns carry set if out of range (including negative numbers).
  1094. ;
  1095.         public    sl_FTOUL
  1096. sl_FTOUL    proc    far
  1097.         assume    ds:StdGrp
  1098.         push    ds
  1099.         push    cx
  1100.         mov    cx, StdGrp
  1101.         mov    ds, cx
  1102. ;
  1103.         mov    cx, fpacc.Exponent
  1104.         cmp    cx, 801fh
  1105.         jb    FTOULok
  1106. BadUL:        stc
  1107.         jmp    ULTooBig
  1108. ;
  1109. FTOULok:    call    DoFTOUL
  1110.         cmp    fpacc.Sign, 0
  1111.         js    BadUL
  1112. ;
  1113.         clc                ;If the # is okay.
  1114. ULTooBig:    pop    cx
  1115.         pop    ds
  1116.         ret
  1117. sl_FTOUL    endp
  1118. ;
  1119. ;
  1120. ; DoFTOUL- This code does the actual conversion!
  1121. ;
  1122. DoFTOUL        proc    near
  1123.         mov    dx, fpacc.Mantissa [6]
  1124.         mov    ax, fpacc.Mantissa [4]
  1125.         cmp    cx, 7fffh
  1126.         jb    SetFTOUL0
  1127.         sub    cx, 801eh
  1128.         neg    cx
  1129.         jcxz    SetFTOULDone
  1130. FTOULLp:    shr    dx, 1
  1131.         rcr    ax, 1
  1132.         loop    FTOULLp
  1133. SetFToULDone:    ret
  1134. ;
  1135. SetFTOUL0:    xor    ax, ax
  1136.         xor    dx, dx
  1137.         ret
  1138. DoFTOUL        endp
  1139. ;
  1140. ;
  1141. ;
  1142. ;
  1143. ;
  1144. ;
  1145. ;
  1146. ;
  1147. ;
  1148. ;
  1149. ;
  1150. ;
  1151. ;
  1152. ;---------------------------------------------------------------------------
  1153. ;        Floating Point Addition & Subtraction
  1154. ;---------------------------------------------------------------------------
  1155. ;
  1156. ;
  1157. ;
  1158. ;
  1159. ; FADD- Adds FOP to FACC
  1160. ; FSUB- Subtracts FOP from FACC
  1161. ;    These routines destroy the value in FPOP!
  1162. ;
  1163.         public    sl_fsub
  1164.         public    sl_fadd
  1165. ;
  1166.         assume    ds:nothing
  1167. sl_fsub        proc    far
  1168.         xor    StdGrp:fpop.sign, 80h
  1169. sl_fsub        endp
  1170. ;
  1171.         assume    ds:StdGrp
  1172. sl_fadd        proc    far
  1173.         push    ds
  1174.         push    ax
  1175.         push    bx
  1176.         push    cx
  1177.         push    dx
  1178.         push    si
  1179. ;
  1180. ; Use the current CS as the data segment to get direct access to
  1181. ; the floating point accumulator and operands.
  1182. ;
  1183.         mov    ax, StdGrp
  1184.         mov    ds, ax
  1185. ;
  1186. ; Adjust the smaller of the two operands so that the exponents of the two
  1187. ; objects are the same:
  1188. ;
  1189.         mov    cx, fpacc.exponent
  1190.         sub    cx, fpop.exponent
  1191.         js    gotoAdjustFPA
  1192.         jnz    AdjustFPOP
  1193.         jmp    Adjusted        ;Only if exponents are equal.
  1194. gotoAdjustFPA:    jmp    AdjustFPACC
  1195. ;
  1196. ; Since the difference of the exponents is negative, the magnitude of FPOP
  1197. ; is smaller than the magnitude of fpacc.  Adjust FPOP here.
  1198. ;
  1199. AdjustFPOP:    cmp    cx, 64            ;If greater than 64, forget
  1200.         jb    short By16LoopTest    ; it.  Sum is equal to FPACC.
  1201.         jmp    Done
  1202. ;
  1203. ; If the difference is greater than 16 bits, adjust FPOP a word at a time.
  1204. ; Note that there may be multiple words adjusted in this fashion.
  1205. ;
  1206. By16Loop:    mov    ax, fpop.mantissa[2]
  1207.         mov    fpop.mantissa[0], ax
  1208.         mov    ax, fpop.mantissa[4]
  1209.         mov    fpop.mantissa[2], ax
  1210.         mov    ax, fpop.mantissa[6]
  1211.         mov    fpop.mantissa[4], ax
  1212.         mov    fpop.mantissa[6], 0
  1213.         sub    cx, 16
  1214. By16LoopTest:    cmp    cx, 16
  1215.         jae    By16Loop
  1216. ;
  1217. ; After adjusting sixteen bits at a time, see if there are at least eight
  1218. ; bits.  Note that this can only occur once, for if you could adjust by
  1219. ; eight bits twice, you could have adjusted by 16 above.
  1220. ;
  1221.         cmp    cx, 8
  1222.         jb    NotBy8
  1223.         mov    ax, fpop.mantissa[1]
  1224.         mov    fpop.mantissa[0], ax
  1225.         mov    ax, fpop.mantissa[3]
  1226.         mov    fpop.mantissa[2], ax
  1227.         mov    ax, fpop.mantissa[5]
  1228.         mov    fpop.mantissa[4], ax
  1229.         mov    al, byte ptr fpop.mantissa [7]
  1230.         mov    byte ptr fpop.mantissa [6], al
  1231.         mov    byte ptr fpop.mantissa[7], 0
  1232.         sub    cx, 8
  1233. ;
  1234. ; Well, now we're down to a bit at a time.
  1235. ;
  1236. NotBy8:        jcxz    AdjFPOPDone
  1237. ;
  1238. ; Load the mantissa into registers to save processing time.
  1239. ;
  1240.         mov    ax, fpop.mantissa[6]
  1241.         mov    bx, fpop.mantissa[4]
  1242.         mov    dx, fpop.mantissa[2]
  1243.         mov    si, fpop.mantissa[0]
  1244. By1Loop:    shr    ax, 1
  1245.         rcr    bx, 1
  1246.         rcr    dx, 1
  1247.         rcr    si, 1
  1248.         loop    By1Loop
  1249.         mov    fpop.mantissa[6], ax    ;Save result back into
  1250.         mov    fpop.mantissa[4], bx    ; fpop.
  1251.         mov    fpop.mantissa[2], dx
  1252.         mov    fpop.mantissa[0], si
  1253. AdjFPOPDone:    jmp     Adjusted
  1254. ;
  1255. ;
  1256. ;
  1257. ; AdjustFPACC- FPACC was smaller than FPOP, so adjust its bits down here.
  1258. ;           This code is pretty much identical to the above, the same
  1259. ;           comments apply.
  1260. ;
  1261. AdjustFPACC:    neg    cx            ;Take ABS(cx)
  1262.         cmp    cx, 64            ;If greater than 64, forget
  1263.         jb    By16LpTest        ; it.
  1264.         jmp    SetFPACC2Zero
  1265. ;
  1266. By16Lp:        mov    ax, fpacc.mantissa[2]
  1267.         mov    fpacc.mantissa[0], ax
  1268.         mov    ax, fpacc.mantissa[4]
  1269.         mov    fpacc.mantissa[2], ax
  1270.         mov    ax, fpacc.mantissa[6]
  1271.         mov    fpacc.mantissa[4], ax
  1272.         mov    fpacc.mantissa[6], 0
  1273.         sub    cx, 16
  1274. By16LpTest:    cmp    cx, 16
  1275.         jae    By16Lp
  1276. ;
  1277.         cmp    cx, 8
  1278.         jb    NotBy8a
  1279.         mov    ax, fpacc.mantissa[1]
  1280.         mov    fpacc.mantissa[0], ax
  1281.         mov    ax, fpacc.mantissa[3]
  1282.         mov    fpacc.mantissa[2], ax
  1283.         mov    ax, fpacc.mantissa[5]
  1284.         mov    fpacc.mantissa[4], ax
  1285.         mov    al, byte ptr fpacc.mantissa [7]
  1286.         mov    byte ptr fpacc.mantissa [6], al
  1287.         mov    byte ptr fpacc.mantissa[7], 0
  1288.         sub    cx, 8
  1289. ;
  1290. NotBy8a:    jcxz    Adjusted
  1291.         mov    ax, fpacc.mantissa[6]
  1292.         mov    bx, fpacc.mantissa[4]
  1293.         mov    dx, fpacc.mantissa[2]
  1294.         mov    si, fpacc.mantissa[0]
  1295. By1Lp:        shr    ax, 1
  1296.         rcr    bx, 1
  1297.         rcr    dx, 1
  1298.         rcr    si, 1
  1299.         loop    By1Lp
  1300.         mov    fpacc.mantissa[6], ax
  1301.         mov    fpacc.mantissa[4], bx
  1302.         mov    fpacc.mantissa[2], dx
  1303.         mov    fpacc.mantissa[0], si
  1304.         mov    ax, fpop.Exponent    ;FPACC assumes the same
  1305.         mov    fpacc.Exponent, ax    ; exponent as FPOP.
  1306. AdjFPACCDone:    jmp     Adjusted
  1307. ;
  1308. ; If FPACC is so much smaller than FPOP that it is insignificant, set
  1309. ; it to zero.
  1310. ;
  1311. SetFPACC2Zero:    xor    ax, ax
  1312.         mov    fpacc.mantissa[0], ax
  1313.         mov    fpacc.mantissa[2], ax
  1314.         mov    fpacc.mantissa[4], ax
  1315.         mov    fpacc.mantissa[6], ax
  1316.         mov    fpacc.exponent, ax
  1317.         mov    fpacc.sign, al
  1318. ;
  1319. ; Now that the mantissas are aligned, let's add (or subtract) them.
  1320. ;
  1321. Adjusted:    mov    al, fpacc.sign
  1322.         xor    al, fpop.sign
  1323.         js    SubEm
  1324. ;
  1325. ; If the signs are the same, simply add the mantissas together here.
  1326. ;
  1327.         mov    ax, fpop.mantissa[0]
  1328.         add    fpacc.mantissa[0], ax
  1329.         mov    ax, fpop.mantissa[2]
  1330.         adc    fpacc.mantissa[2], ax
  1331.         mov    ax, fpop.mantissa[4]
  1332.         adc    fpacc.mantissa[4], ax
  1333.         mov    ax, fpop.mantissa[6]
  1334.         adc    fpacc.mantissa[6], ax
  1335.         jnc    Normalize
  1336. ;
  1337. ; If there was a carry out of the addition (quite possible since most
  1338. ; fp values are normalized) then we need to shove the bit back into
  1339. ; the number.
  1340. ;
  1341.         rcr    fpacc.mantissa[6], 1
  1342.         rcr    fpacc.mantissa[4], 1
  1343.         rcr    fpacc.mantissa[2], 1
  1344.         rcr    fpacc.mantissa[0], 1
  1345.         inc    fpacc.exponent
  1346. ;
  1347. ; If there was a carry out of the bottom, add it back in (this rounds the
  1348. ; result).  No need to worry about a carry out of the H.O. bit this time--
  1349. ; there is no way to add together two numbers to get a carry *and* all
  1350. ; one bits in the result.  Therefore, rounding at this point will not
  1351. ; propagate all the way through.
  1352. ;
  1353.         adc    fpacc.Mantissa [0], 0
  1354.         jnc    Normalize
  1355.         inc    fpacc.Mantissa [2]
  1356.         jnz    Normalize
  1357.         inc    fpacc.Mantissa [4]
  1358.         jnz    Normalize
  1359.         inc    fpacc.Mantissa [6]
  1360.         jmp    Normalize
  1361. ;
  1362. ;
  1363. ;
  1364. ; If the signs are different, we've got to deal with four possibilities:
  1365. ;
  1366. ; 1) fpacc is negative and its magnitude is greater than fpop's.
  1367. ;    Result is negative, fpacc.mant := fpacc.mant - fpop.mant.
  1368. ;
  1369. ; 2) fpacc is positive and its magnitude is greater than fpop's.
  1370. ;    Result is positive, fpacc.mant := fpacc.mant - fpop.mant.
  1371. ;
  1372. ; 3) fpacc is negative and its magnitude is less than fpop's.
  1373. ;    Result is positive, fpacc.mant := fpop.mant - fpacc.mant.
  1374. ;
  1375. ; 4) fpacc is positive and its magnitude is less than fpop's.
  1376. ;    Result is negative, fpacc.mant := fpop.mant - fpacc.mant.
  1377. ;
  1378. SubEm:        mov    ax, fpacc.mantissa[0]
  1379.         mov    bx, fpacc.mantissa[2]
  1380.         mov    dx, fpacc.mantissa[4]
  1381.         mov    si, fpacc.mantissa[6]
  1382.         sub    ax, fpop.mantissa[0]
  1383.         sbb    bx, fpop.mantissa[2]
  1384.         sbb    dx, fpop.mantissa[4]
  1385.         sbb     si, fpop.mantissa[6]
  1386.         jnc    StoreFPACC
  1387. ;
  1388. ; Whoops!  FPOP > FPACC, fix that down here.
  1389. ;
  1390.         not    ax
  1391.         not    bx
  1392.         not    dx
  1393.         not    si
  1394.         inc     ax
  1395.         jnz    StoreFPACCSign
  1396.         inc    bx
  1397.         jnz    StoreFPAccSign
  1398.         inc    dx
  1399.         jnz    StoreFPAccSign
  1400.         inc    si
  1401. ;
  1402. StoreFPAccSign:    xor    fpacc.sign, 80h            ;Flip sign if case 3/4.
  1403. ;
  1404. StoreFPAcc:    mov    fpacc.mantissa[0], ax
  1405.         mov    fpacc.mantissa[2], bx
  1406.         mov    fpacc.mantissa[4], dx
  1407.         mov    fpacc.mantissa[6], si
  1408. ;
  1409. ;
  1410. ; Normalize the result down here.  Start by shifting 16 bits at a time,
  1411. ; then eight bits, then one bit at a time.
  1412. ;
  1413. Normalize:    mov    ax, fpacc.mantissa[6]
  1414.         or    ax, ax                  ;See if zero (which means we
  1415.         jnz    Try8Bits        ; can shift 16 bits).
  1416.         mov    ax, fpacc.mantissa[4]
  1417.         mov    fpacc.mantissa[6], ax
  1418.         mov    ax, fpacc.mantissa[2]
  1419.         mov    fpacc.mantissa[4], ax
  1420.         mov    ax, fpacc.mantissa[0]
  1421.         mov    fpacc.mantissa[2], ax
  1422.         mov    fpacc.mantissa[0],0
  1423.         sub    fpacc.exponent, 16
  1424.         jmp    Normalize
  1425. ;
  1426. ; Okay, see if we can normalize eight bits at a shot.
  1427. ;
  1428. Try8Bits:    mov    al, byte ptr fpacc.mantissa[7]
  1429.         cmp    al, 0
  1430.         jnz    Try1Bit
  1431.         mov    ax, fpacc.mantissa[5]
  1432.         mov    fpacc.mantissa[6], ax
  1433.         mov    ax, fpacc.mantissa[3]
  1434.         mov    fpacc.mantissa[4], ax
  1435.         mov    ax, fpacc.mantissa[1]
  1436.         mov    fpacc.mantissa[3], ax
  1437.         mov    al, byte ptr fpacc.mantissa[0]
  1438.         mov    byte ptr fpacc.mantissa[1], al
  1439.         mov    byte ptr fpacc.mantissa[0], 0
  1440.         sub    fpacc.exponent, 8
  1441. ;
  1442. Try1Bit:    mov    ax, fpacc.mantissa[6]
  1443.         test    ah, 80h
  1444.         jnz    Done
  1445.         mov    bx, fpacc.mantissa[4]
  1446.         mov    dx, fpacc.mantissa[2]
  1447.         mov    si, fpacc.mantissa[0]
  1448. OneBitLp:    dec    fpacc.exponent
  1449.         shl    si, 1
  1450.         rcl    dx, 1
  1451.         rcl    bx, 1
  1452.         rcl    ax, 1
  1453.         or    ax, ax            ;See if bit 15 is set.
  1454.         jns    OneBitLp
  1455.         mov    fpacc.mantissa[6], ax
  1456.         mov    fpacc.mantissa[4], bx
  1457.         mov    fpacc.mantissa[2], dx
  1458.         mov    fpacc.mantissa[0], si
  1459. ;
  1460. Done:        pop    si
  1461.         pop    dx
  1462.         pop    cx
  1463.         pop    bx
  1464.         pop    ax
  1465.         pop    ds
  1466.         ret
  1467. sl_fadd        endp
  1468. ;
  1469. ;
  1470. ;
  1471. ;
  1472. ;
  1473. ;
  1474. ;
  1475. ;
  1476. ;
  1477. ;
  1478. ;---------------------------------------------------------------------------
  1479. ; Floating point comparison.
  1480. ;---------------------------------------------------------------------------
  1481. ;
  1482. ;
  1483. ; FCMP
  1484. ; Compares value in FPACC to value in FPOP.
  1485. ; Returns -1 in AX if FPACC is less than FPOP,
  1486. ; Returns 0  in AX if FPACC is equal to FPOP,
  1487. ; Returns 1  in AX if FPACC is greater than FPOP.
  1488. ;
  1489. ; Also returns this status in the flags (by comparing AX against zero
  1490. ; before returning) so you can use JE, JNE, JG, JGE, JL, or JLE after this
  1491. ; routine to test the comparison.
  1492. ;
  1493.         public    sl_fcmp
  1494. sl_fcmp        proc    far
  1495.         assume    ds:StdGrp
  1496.         push    ds
  1497.         mov    ax, StdGrp
  1498.         mov    ds, ax
  1499. ;
  1500. ; First compare the signs of the mantissas.  If they are different, the
  1501. ; negative one is smaller.
  1502. ;
  1503.         mov    al, byte ptr FPACC+10    ;Get sign bit
  1504.         xor    al, byte ptr FPOP+10    ;See if the signs are different
  1505.         jns    SameSign
  1506. ;
  1507. ; If the signs are different, then the sign of FPACC determines the result
  1508. ;
  1509.         test    byte ptr FPACC+10, 80h
  1510.         jnz    IsLT
  1511.         jmp    short IsGT
  1512. ;
  1513. ; Down here the signs are the same.  First order of business is to compare
  1514. ; the exponents.  The one with the larger exponent wins.  If the exponents
  1515. ; are equal, then we need to compare the mantissas.  If the mantissas are
  1516. ; the same then the two numbers are equal.  If the mantissas are different
  1517. ; then the larger one wins.  Note that this discussion is for positive values
  1518. ; only, if the numbers are negative, then we must reverse the win/loss value
  1519. ; (win=GT).
  1520. ;
  1521. SameSign:    mov    ax, FPACC.exponent    ;One thing cool about bias-
  1522.         cmp    ax, FPOP.exponent    ; 1023 exponents is that we
  1523.         ja    MayBeGT            ; can use an unsigned compare
  1524.         jb    MayBeLT
  1525. ;
  1526. ; If the exponents are equal, we need to start comparing the mantissas.
  1527. ; This straight line code turns out to be about the fastest way to do it.
  1528. ;
  1529.         mov    ax, word ptr FPACC.mantissa+6
  1530.         cmp    ax, word ptr FPOP.mantissa+6
  1531.         ja    MayBeGT
  1532.         jb    MayBeLT
  1533.         mov    ax, word ptr FPACC.mantissa+4
  1534.         cmp    ax, word ptr FPOP.mantissa+4
  1535.         ja    MayBeGT
  1536.         jb    MayBeLT
  1537.         mov    ax, word ptr FPACC.mantissa+2
  1538.         cmp    ax, word ptr FPOP.mantissa+2
  1539.         ja    MayBeGT
  1540.         jb    MayBeLT
  1541.         mov    ax, word ptr FPACC.mantissa
  1542.         cmp    ax, word ptr FPOP.mantissa
  1543.         ja    MayBeGT
  1544.         je    IsEq            ;They're equal at this point.
  1545. ;
  1546. ; MayBeLT- Looks like less than so far, but we need to check the sign of the
  1547. ; numbers, if they are negative then FPACC is really GT FPOP.  Remember, the
  1548. ; sign is not part of the mantissa!
  1549. ;
  1550. MayBeLT:    test    FPACC.sign, 80h
  1551.         js    IsGT
  1552. ;
  1553. IsLT:        mov    ax, -1
  1554.         jmp    short cmpRtn
  1555. ;
  1556. ; Same story here for MayBeGT
  1557. ;
  1558. MayBeGT:    test    FPACC.sign, 80h
  1559.         js    IsLT
  1560. ;
  1561. IsGT:        mov    ax, 1
  1562.         jmp    short cmpRtn
  1563. ;
  1564. IsEq:        xor    ax, ax
  1565. cmpRtn:        pop    ds
  1566.         cmp    ax, 0            ;Set the flags as appropriate
  1567.         ret
  1568. sl_fcmp        endp
  1569.         assume    ds:nothing
  1570. ;
  1571. ;
  1572. ;
  1573. ;
  1574. ;
  1575. ;
  1576. ;
  1577. ;
  1578. ;
  1579. ;
  1580. ;
  1581. ;
  1582. ;
  1583. ;---------------------------------------------------------------------------
  1584. ;        Floating Point Multiplication
  1585. ;---------------------------------------------------------------------------
  1586. ;
  1587. ;
  1588. ;
  1589. ;
  1590. ; sl_fmul- Multiplies facc by fop and leaves the result in facc.
  1591. ;
  1592.         public    sl_fmul
  1593. sl_fmul        proc    far
  1594.         assume    ds:StdGrp
  1595.         push    ds
  1596.         push    ax
  1597.         push    bx
  1598.         push    cx
  1599.         push    dx
  1600.         push    si
  1601.         push    di
  1602. ;
  1603.         mov    ax, StdGrp
  1604.         mov    ds, ax
  1605. ;
  1606. ; See if either operand is zero:
  1607. ;
  1608.         mov    ax, fpacc.mantissa[0]    ;No need to check exponent!
  1609.         or    ax, fpacc.mantissa[2]
  1610.         or    ax, fpacc.mantissa[4]
  1611.         or    ax, fpacc.mantissa[6]
  1612.         jz    ProdIsZero
  1613. ;
  1614.         mov    ax, fpop.mantissa[0]
  1615.         or    ax, fpop.mantissa[2]
  1616.         or    ax, fpop.mantissa[4]
  1617.         or    ax, fpop.mantissa[6]
  1618.         jnz    ProdNotZero
  1619. ;
  1620. ProdIsZero:    xor    ax, ax            ;Need this!
  1621.         mov    fpacc.sign, al
  1622.         mov    fpacc.exponent, ax
  1623.         mov    fpacc.mantissa[0], ax
  1624.         mov    fpacc.mantissa[2], ax
  1625.         mov    fpacc.mantissa[4], ax
  1626.         mov    fpacc.mantissa[6], ax
  1627.         jmp    FMulDone
  1628. ;
  1629. ; If both operands are non-zero, compute the true product down here.
  1630. ;
  1631. ProdNotZero:    mov    al, fpop.sign        ;Compute the new sign.
  1632.         xor    fpacc.sign, al
  1633. ;
  1634. ; Eliminate bias in the exponents, add them, and check for 16-bit signed
  1635. ; overflow.
  1636. ;
  1637.         mov    ax, fpop.exponent    ;Compute new exponent.
  1638.         sub    ax, 7fffh        ;Subtract BIAS and adjust
  1639.         mov    bx, fpacc.Exponent
  1640.         sub    bx, 7fffh
  1641.         add    ax, bx            ; for fractional multiply.
  1642.         jno    GoodExponent
  1643. ;
  1644. ; If the exponent overflowed, set up the overflow value here.
  1645. ;
  1646.         mov    ax, 0ffffh
  1647.         mov    fpacc.exponent, ax    ;Largest exponent value
  1648.         mov    fpacc.mantissa[0], ax    ; and largest mantissa, too!
  1649.         mov    fpacc.mantissa[2], ax
  1650.         mov    fpacc.mantissa[4], ax
  1651.         mov    fpacc.mantissa[6], ax
  1652.         jmp    FMulDone
  1653. ;
  1654. GoodExponent:    add    ax, 8000h        ;Add the bias back in (note
  1655.         mov    fpacc.Exponent, ax    ; Mul64 below causes shift
  1656. ;                        ; to force bias of 7fffh.
  1657. ; Okay, compute the product of the mantissas down here.
  1658. ;
  1659.         call    Mul64
  1660. ;
  1661. ; Normalize the product.  Note: we know the product is non-zero because
  1662. ; both of the original operands were non-zero.
  1663. ;
  1664.         mov    cx, fpacc.exponent
  1665.         jmp    short TestNrmMul
  1666. NrmMul1:    sub    cx, 16
  1667.         mov    ax, fprod[12]
  1668.         mov    fprod[14], ax
  1669.         mov    ax, fprod[10]
  1670.         mov    fprod[12], ax
  1671.         mov    ax, fprod[8]
  1672.         mov    fprod[10], ax
  1673.         mov    ax, fprod[6]
  1674.         mov    fprod[8], ax
  1675.         mov    ax, fprod[4]
  1676.         mov    fprod[6], ax
  1677.         mov    ax, fprod[2]
  1678.         mov    fprod[4], ax
  1679.         mov    ax, fprod[0]
  1680.         mov    fprod[2], ax
  1681.         mov    fprod[0], 0
  1682. TestNrmMul:     cmp    cx, 16
  1683.         jb    DoNrmMul8
  1684.         mov      ax, fprod[14]
  1685.         or    ax, ax
  1686.         jz    NrmMul1
  1687. ;
  1688. ; See if we can shift the product a whole byte
  1689. ;
  1690. DoNrmMul8:    cmp    ah, 0            ;Contains fprod[15] from above.
  1691.         jnz    DoOneBits
  1692.         cmp    cx, 8
  1693.         jb    DoOneBits
  1694.         mov    ax, fprod[13]
  1695.         mov    fprod[14], ax
  1696.         mov    ax, fprod[11]
  1697.         mov    fprod[12], ax
  1698.         mov    ax, fprod[9]
  1699.         mov    fprod[10], ax
  1700.         mov    ax, fprod[7]
  1701.         mov    fprod[8], ax
  1702.         mov    ax, fprod[5]
  1703.         mov    fprod[6], ax
  1704.         mov    ax, fprod[3]
  1705.         mov    fprod[4], ax
  1706.         mov    ax, fprod[1]
  1707.         mov    fprod[2], ax
  1708.         mov    al, byte ptr fprod[0]
  1709.         mov    byte ptr fprod[1], al
  1710.         mov    byte ptr fprod[0], 0
  1711.         sub    cx, 8
  1712. ;
  1713. DoOneBits:    mov    ax, fprod[14]
  1714.         mov    bx, fprod[12]
  1715.         mov    dx, fprod[10]
  1716.         mov    si, fprod[8]
  1717.         mov    di, fprod[6]
  1718.         jmp    short TestOneBits
  1719. ;
  1720. OneBitLoop:    shl    fprod[0], 1
  1721.         rcl    fprod[2], 1
  1722.         rcl    fprod[4], 1
  1723.         rcl    di, 1
  1724.         rcl    si, 1
  1725.         rcl    dx, 1
  1726.         rcl    bx, 1
  1727.         rcl    ax, 1
  1728.         dec    cx
  1729. TestOneBits:    jcxz    StoreProd
  1730.         test    ah, 80h
  1731.         jz    OneBitLoop
  1732. ;
  1733. StoreProd:    mov    fpacc.mantissa[6], ax
  1734.         mov    fpacc.mantissa[4], bx
  1735.         mov    fpacc.mantissa[2], dx
  1736.         mov    fpacc.mantissa[0], si
  1737.         mov    fpacc.exponent, cx
  1738.         or    ax, bx
  1739.         or    ax, dx
  1740.         or    ax, si
  1741.         jnz    FMulDone
  1742. ;
  1743. ; If underflow occurs, set the result to zero.
  1744. ;
  1745.         mov    fpacc.exponent, ax
  1746.         mov    fpacc.sign, al
  1747. ;
  1748. FMulDone:    pop    di
  1749.         pop    si
  1750.         pop    dx
  1751.         pop    cx
  1752.         pop    bx
  1753.         pop    ax
  1754.         pop    ds
  1755.         ret
  1756. sl_fmul        endp
  1757.         assume    ds:nothing
  1758. ;
  1759. ;
  1760. ;
  1761. ;
  1762. ; Mul64- Multiplies the 8 bytes in fpacc.mant by the 8 bytes in fpop.mant
  1763. ;     and leaves the result in fprod.
  1764. ;
  1765. Mul64        proc    near
  1766.         assume    ds:StdGrp
  1767.         xor    ax, ax
  1768.         mov    fprod[0], ax
  1769.         mov    fprod[2], ax
  1770.         mov    fprod[4], ax
  1771.         mov    fprod[6], ax
  1772.         mov    fprod[8], ax
  1773.         mov    fprod[10], ax
  1774.         mov    fprod[12], ax
  1775.         mov    fprod[14], ax
  1776. ;
  1777. ; Computing the following (each character represents 16-bits):
  1778. ;
  1779. ;    A B C D
  1780. ;    x  E F G H
  1781. ;    -------
  1782. ;
  1783. ; Product is computed by:
  1784. ;
  1785. ;    A B C D
  1786. ;    x  E F G H
  1787. ;    ----------
  1788. ;            HD
  1789. ;        HC0
  1790. ;          HB00
  1791. ;      HA000
  1792. ;        GD0
  1793. ;          GC00
  1794. ;         GB000
  1795. ;        GA0000
  1796. ;          FD00
  1797. ;      FC000
  1798. ;        FB0000
  1799. ;       FA00000
  1800. ;         ED000
  1801. ;        EC0000
  1802. ;       EB00000
  1803. ;    + EA000000
  1804. ;    ----------
  1805. ;      xxxxxxxx
  1806. ;
  1807. ; In the loop below, si indexes through A, B, C, and D above (or E, F, G,
  1808. ; and H since multiplication is commutative).
  1809. ;
  1810.         mov    si, ax            ;Set Index to zero.
  1811. flp1:        mov    ax, fpacc.mantissa[si]    ;Multiply A, B, C, or D
  1812.         mul    fpop.mantissa[0]    ; by H.
  1813.         add    fprod [si], ax        ;Add it into the partial
  1814.         adc    fprod+2 [si], dx    ; product computed so far.
  1815.         jnc    NoCarry0
  1816.         inc    fprod+4 [si]
  1817.         jnz    NoCarry0
  1818.         inc    fprod+6 [si]
  1819.         jnz    NoCarry0
  1820.         inc    fprod+8 [si]
  1821.         jnz    NoCarry0
  1822.         inc    fprod+10 [si]
  1823.         jnz    NoCarry0
  1824.         inc    fprod+12 [si]
  1825.         jnz    NoCarry0
  1826.         inc    fprod+14 [si]
  1827. ;
  1828. NoCarry0:
  1829.         mov    ax, fpacc.mantissa[si]    ;Multiply A, B, C, or D
  1830.         mul    fpop.mantissa[2]    ; (selected by SI) by G
  1831.         add    fprod+2 [si], ax    ; and add it into the
  1832.         adc    fprod+4 [si], dx    ; partial product.
  1833.         jnc    NoCarry1
  1834.         inc    fprod+6 [si]
  1835.         jnz    NoCarry1
  1836.         inc    fprod+8 [si]
  1837.         jnz    NoCarry1
  1838.         inc    fprod+10 [si]
  1839.         jnz    NoCarry1
  1840.         inc    fprod+12 [si]
  1841.         jnz    NoCarry1
  1842.         inc    fprod [14]
  1843. ;
  1844. NoCarry1:
  1845.         mov    ax, fpacc.mantissa [si]    ;Multiply A, B, C, or D
  1846.         mul    fpop.mantissa [4]    ; (SI selects) by F and add
  1847.         add    fprod+4 [si], ax    ; it into the partial prod.
  1848.         adc    fprod+6 [si], dx
  1849.         jnc    NoCarry2
  1850.         inc    fprod+8 [si]
  1851.         jnz    NoCarry2
  1852.         inc    fprod+10 [si]
  1853.         jnz    NoCarry2
  1854.         inc    fprod+12 [si]
  1855.         jnz    NoCarry2
  1856.         inc    fprod+14 [si]
  1857. ;
  1858. NoCarry2:
  1859.         mov    ax, fpacc.mantissa [si]    ;Multiply A/B/C/D (selected
  1860.         mul    fpop.mantissa [6]    ; by SI) by E and add it
  1861.         add    fprod+6 [si], ax    ; into the partial product.
  1862.         adc    fprod+8 [si], dx
  1863.         jnc    NoCarry3
  1864.         inc    fprod+10 [si]
  1865.         jnz    NoCarry3
  1866.         inc    fprod+12 [si]
  1867.         jnz    NoCarry3
  1868.         inc    fprod+14 [si]
  1869. ;
  1870. NoCarry3:
  1871.         inc    si            ;Select next multiplier
  1872.         inc    si            ; (B, C, or D above).
  1873.         cmp    si, 8            ;Repeat for 64 bit x 64 bit
  1874.         jnb    QuitMul64        ; multiply.
  1875.         jmp    flp1
  1876. QuitMul64:    ret
  1877.         assume    ds:nothing
  1878. Mul64        endp
  1879. ;
  1880. ;
  1881. ;
  1882. ;
  1883. ;
  1884. ;
  1885. ;
  1886. ;
  1887. ;---------------------------------------------------------------------------
  1888. ;        Floating Point Division
  1889. ;---------------------------------------------------------------------------
  1890. ;
  1891. ;
  1892. ;
  1893. ;
  1894. ; Floating point division: Divides fpacc by fpop.
  1895. ;
  1896.         public    sl_fdiv
  1897. sl_fdiv        proc    far
  1898.         assume    ds:StdGrp
  1899.         push    ds
  1900.         push    ax
  1901.         push    bx
  1902.         push    cx
  1903.         push    dx
  1904.         push    si
  1905.         push    di
  1906.         push    bp
  1907. ;
  1908.         mov    ax, StdGrp
  1909.         mov    ds, ax
  1910. ;
  1911. ; See if either operand is zero:
  1912. ;
  1913.         mov    ax, fpacc.mantissa[0]    ;No need to check exponent!
  1914.         or    ax, fpacc.mantissa[2]
  1915.         or    ax, fpacc.mantissa[4]
  1916.         or    ax, fpacc.mantissa[6]
  1917.         jz    QuoIsZero
  1918. ;
  1919.         mov    ax, fpop.mantissa[0]
  1920.         or    ax, fpop.mantissa[2]
  1921.         or    ax, fpop.mantissa[4]
  1922.         or    ax, fpop.mantissa[6]
  1923.         jnz    DenomNotZero
  1924. ;
  1925. ; Whoops! Division by zero!  Set to largest possible value (+inf) and leave.
  1926. ;
  1927. DivOvfl:    mov    ax, 0ffffh
  1928.         mov    fpacc.exponent, ax
  1929.         mov    fpacc.mantissa[0], ax
  1930.         mov    fpacc.mantissa[2], ax
  1931.         mov    fpacc.mantissa[4], ax
  1932.         mov    fpacc.mantissa[6], ax
  1933.         mov    al, fpop.sign
  1934.         xor    fpacc.sign, al
  1935. ;
  1936. ; Note: we could also do an INT 0 (div by zero) or floating point exception
  1937. ; here, if necessary.
  1938. ;
  1939.         jmp    FDivDone
  1940. ;
  1941. ;
  1942. ; If the numerator is zero, the quotient is zero.  Handle that here.
  1943. ;
  1944. QuoIsZero:    xor    ax, ax            ;Need this!
  1945.         mov    fpacc.sign, al
  1946.         mov    fpacc.exponent, ax
  1947.         mov    fpacc.mantissa[0], ax
  1948.         mov    fpacc.mantissa[2], ax
  1949.         mov    fpacc.mantissa[4], ax
  1950.         mov    fpacc.mantissa[6], ax
  1951.         jmp    FDivDone
  1952. ;
  1953. ;
  1954. ;
  1955. ; If both operands are non-zero, compute the quotient down here.
  1956. ;
  1957. DenomNotZero:    mov    al, fpop.sign        ;Compute the new sign.
  1958.         xor    fpacc.sign, al
  1959. ;
  1960.         mov    ax, fpop.exponent    ;Compute new exponent.
  1961.         sub    ax, 7fffh        ;Subtract BIAS.
  1962.         mov    bx, fpacc.exponent
  1963.         sub    bx, 7fffh
  1964.         sub    bx, ax            ;Compute new exponent
  1965.         jo    DivOvfl
  1966.         add    bx, 7fffh        ;Add in BIAS
  1967.         mov    fpacc.exponent, bx    ;Save as new exponent.
  1968. ;
  1969. ; Okay, compute the quotient of the mantissas down here.
  1970. ;
  1971.         call    Div64
  1972. ;
  1973. ; Normalize the Quotient.
  1974. ;
  1975.         mov    cx, fpacc.exponent
  1976.         jmp    short TestNrmDiv
  1977. ;
  1978. ; Normalize by shifting 16 bits at a time here.
  1979. ;
  1980. NrmDiv1:    sub    cx, 16
  1981.         mov    ax, fpacc.mantissa[4]
  1982.         mov    fpacc.mantissa[6], ax
  1983.         mov    ax, fpacc.mantissa[2]
  1984.         mov    fpacc.mantissa[4], ax
  1985.         mov    ax, fpacc.mantissa[0]
  1986.         mov    fpacc.mantissa[2], ax
  1987.         mov    fpacc.mantissa[0], 0
  1988. TestNrmDiv:     cmp    cx, 16
  1989.         jb    DoNrmDiv8
  1990.         mov      ax, fpacc.mantissa[6]
  1991.         or    ax, ax
  1992.         jz    NrmDiv1
  1993. ;
  1994. ; Normalize by shifting eight bits at a time here.
  1995. ;
  1996. ; See if we can shift the product a whole byte
  1997. ;
  1998. DoNrmDiv8:    cmp    byte ptr fpacc.mantissa[7], 0
  1999.         jnz    DoOneBitsDiv
  2000.         cmp    cx, 8
  2001.         jb    DoOneBitsDiv
  2002.         mov    ax, fpacc.mantissa[5]
  2003.         mov    fpacc.mantissa[6], ax
  2004.         mov    ax, fpacc.mantissa[3]
  2005.         mov    fpacc.mantissa[4], ax
  2006.         mov    ax, fpacc.mantissa[1]
  2007.         mov    fpacc.mantissa[2], ax
  2008.         mov    al, byte ptr fpacc.mantissa[0]
  2009.         mov    byte ptr fpacc.mantissa[1], al
  2010.         mov    byte ptr fpacc.mantissa[0], 0
  2011.         sub    cx, 8
  2012. ;
  2013. DoOneBitsDiv:    mov    ax, fpacc.mantissa[6]
  2014.         mov    bx, fpacc.mantissa[4]
  2015.         mov    dx, fpacc.mantissa[2]
  2016.         mov    si, fpacc.mantissa[0]
  2017.         jmp    short TestOneBitsDiv
  2018. ;
  2019. ; One bit at a time normalization here.
  2020. ;
  2021. OneBitLoopDiv:    shl    si, 1
  2022.         rcl    dx, 1
  2023.         rcl    bx, 1
  2024.         rcl    ax, 1
  2025.         dec    cx
  2026. TestOneBitsDiv:    jcxz    StoreQuo
  2027.         test    ah, 80h
  2028.         jz    OneBitLoopDiv
  2029. ;
  2030. StoreQuo:    mov    fpacc.mantissa[6], ax
  2031.         mov    fpacc.mantissa[4], bx
  2032.         mov    fpacc.mantissa[2], dx
  2033.         mov    fpacc.mantissa[0], si
  2034.         mov    fpacc.exponent, cx
  2035.         or    ax, bx
  2036.         or    ax, dx
  2037.         or    ax, si
  2038.         jnz    FDivDone
  2039. ;
  2040. ; If underflow occurs, set the result to zero.
  2041. ;
  2042.         mov    fpacc.exponent, ax
  2043.         mov    fpacc.sign, al
  2044. ;
  2045. FDivDone:    pop    bp
  2046.         pop    di
  2047.         pop    si
  2048.         pop    dx
  2049.         pop    cx
  2050.         pop    bx
  2051.         pop    ax
  2052.         pop    ds
  2053.         ret
  2054. sl_fdiv        endp
  2055.         assume    ds:nothing
  2056. ;
  2057. ;
  2058. ;
  2059. ;
  2060. ; Div64- Divides the 64-bit fpacc.mantissa by the 64-bit fpop.mantissa.
  2061. ;
  2062. div64        proc    near
  2063.         assume    ds:StdGrp
  2064. ;
  2065. ;
  2066. ; First, normalize fpop if necessary and possible:
  2067. ;
  2068.         mov    ax, fpop.mantissa[6]
  2069.         mov    bx, fpop.mantissa[4]
  2070.         mov    cx, fpop.mantissa[2]
  2071.         mov    dx, fpop.mantissa[0]
  2072.         mov    si, fpacc.exponent
  2073.         jmp    short Div16NrmTest
  2074. ;
  2075. ; The following loop normalizes fpop 16 bits at a time.
  2076. ;
  2077. Div16NrmLp:    mov    ax, bx
  2078.         mov    bx, dx
  2079.         mov    cx, dx
  2080.         xor    dx, dx
  2081.         add    si, 16
  2082. Div16NrmTest:    cmp    si, -16
  2083.         ja    Div16Nrm8        ;Must be unsigned because this
  2084.         or    ax, ax            ; is bias arithmetic, not
  2085.         jz    Div16NrmLp        ; two's complement!
  2086. ;
  2087. ;
  2088. ; The following code checks to see if it can normalize by eight bits at
  2089. ; a time.
  2090. ;
  2091. Div16Nrm8:    cmp    si, -8
  2092.         ja    Div1NrmTest        ;Must be unsigned!
  2093.         cmp    ah, 0
  2094.         jnz    Div1NrmTest
  2095.         mov    ah, al
  2096.         mov    al, bh
  2097.         mov    bh, bl
  2098.         mov    bl, ch
  2099.         mov    ch, cl
  2100.         mov    cl, dh
  2101.         mov    dh, dl
  2102.         mov    dl, 0
  2103.         add    si, 8
  2104.         jmp    short Div1NrmTest
  2105. ;
  2106. ; Down here we're stuck with the slow task of normalizing by a bit
  2107. ; at a time.
  2108. ;
  2109. Div1NrmLp:    shl    dx, 1
  2110.         rcl    cx, 1
  2111.         rcl    bx, 1
  2112.         rcl    ax, 1
  2113.         inc    si
  2114. Div1NrmTest:    cmp    si, -1
  2115.         je    DivOvfl2        ;Can't do it!
  2116.         test    ah, 80h
  2117.         jz    Div1NrmLp
  2118.         jmp    short DoSlowDiv
  2119. ;
  2120. ; If overflow occurs, set FPACC to the maximum possible value and quit.
  2121. ;
  2122. DivOvfl2:    mov    ax, 0ffffh
  2123.         mov    fpacc.exponent, ax
  2124.         mov    fpacc.mantissa[0], ax
  2125.         mov    fpacc.mantissa[2], ax
  2126.         mov    fpacc.mantissa[4], ax
  2127.         mov    fpacc.mantissa[6], ax
  2128.         jmp    QuitDiv
  2129. ;
  2130. ; Oh No! A GawdAwful bit-by-bit division routine.  Terribly slow!
  2131. ; Actually, it was sped up a little by checking to see if it could
  2132. ; shift eight or sixteen bits at a time (because it encounters eight
  2133. ; or sixteen zeros during the division).
  2134. ;
  2135. ; Could possibly speed this up some more by checking for the special
  2136. ; case of n/16 bits.  Haven't tried this idea out though.
  2137. ;
  2138. DoSlowDiv:    mov    fpacc.exponent, si
  2139.         mov    si, ax
  2140.         mov    di, bx
  2141.         mov    fpop.mantissa[2], cx
  2142.         mov    fpop.mantissa[0], dx
  2143.         mov    ax, fpacc.mantissa[6]
  2144.         mov    bx, fpacc.mantissa[4]
  2145.         mov    cx, fpacc.mantissa[2]
  2146.         mov    dx, fpacc.mantissa[0]
  2147.         mov    bp, 64
  2148. DivideLoop:    cmp    bp, 16
  2149.         jb      Test8
  2150.         or    ax, ax
  2151.         jnz    Test8
  2152. ;
  2153. ; Do a shift by 16 bits here:
  2154. ;
  2155.         mov    ax, Quotient[4]
  2156.         mov    Quotient[6], ax
  2157.         mov    ax, Quotient[2]
  2158.         mov    Quotient[4], ax
  2159.         mov    ax, Quotient[0]
  2160.         mov    Quotient[2], ax
  2161.         mov    Quotient[0], 0
  2162.         mov    ax, bx
  2163.         mov    bx, cx
  2164.         mov    cx, dx
  2165.         xor    dx, dx
  2166.         sub    bp, 16
  2167.         jnz    DivideLoop
  2168.         jmp    FinishDivide
  2169. ;
  2170. Test8:        cmp    bp, 8
  2171.         jb      Do1
  2172.         cmp    ah, 0
  2173.         jnz    Do1
  2174. ;
  2175. ; Do a shift by 8 bits here:
  2176. ;
  2177.         push    ax
  2178.         mov    ax, Quotient[5]
  2179.         mov    Quotient[6], ax
  2180.         mov    ax, Quotient[3]
  2181.         mov    Quotient[4], ax
  2182.         mov    ax, Quotient[1]
  2183.         mov    Quotient[2], ax
  2184.         mov    al, byte ptr Quotient [0]
  2185.         mov    byte ptr Quotient [1], al
  2186.         mov    byte ptr Quotient[0], 0
  2187.         pop    ax
  2188.         mov    ah, al
  2189.         mov    al, bh
  2190.         mov    bh, bl
  2191.         mov    bl, ch
  2192.         mov    ch, cl
  2193.         mov    cl, dh
  2194.         mov    dh, dl
  2195.         mov    dl, 0
  2196.         sub    bp, 8
  2197.         jz    FinishDivide2
  2198.         jmp    DivideLoop
  2199. FinishDivide2:    jmp    FinishDivide
  2200. ;
  2201. Do1:        cmp    ax, si
  2202.         jb    shift0
  2203.         ja    Shift1
  2204.         cmp    bx, di
  2205.         jb    shift0
  2206.         ja    Shift1
  2207.         cmp    cx, fpop.mantissa[2]
  2208.         jb    shift0
  2209.         ja    shift1
  2210.         cmp    dx, fpop.mantissa[0]
  2211.         jb    shift0
  2212. ;
  2213. ; fpacc.mantiss IS greater than fpop.mantissa, shift a one bit into
  2214. ; the result here:
  2215. ;
  2216. Shift1:        stc
  2217.         rcl    Quotient[0], 1
  2218.         rcl    Quotient[2], 1
  2219.         rcl    Quotient[4], 1
  2220.         rcl    Quotient[6], 1
  2221.         sub    dx, fpop.mantissa[0]
  2222.         sbb    cx, fpop.mantissa[2]
  2223.         sbb    bx, di
  2224.         sbb    ax, si
  2225.         shl    dx, 1
  2226.         rcl    cx, 1
  2227.         rcl    bx, 1
  2228.         rcl    ax, 1            ;Never a carry out.
  2229.         dec    bp
  2230.         jnz    jDivideLoop
  2231.         jmp    FinishDivide
  2232. ;
  2233. ; If fpacc.mantissa was less than fpop.mantissa, shift a zero bit into
  2234. ; the quotient.
  2235. ;
  2236. Shift0:        shl    Quotient[0], 1
  2237.         rcl    Quotient[2], 1
  2238.         rcl    Quotient[4], 1
  2239.         rcl    Quotient[6], 1
  2240.         shl    dx, 1
  2241.         rcl    cx, 1
  2242.         rcl    bx, 1
  2243.         rcl    ax, 1
  2244.         jc    Greater
  2245.         dec    bp
  2246.         jnz    jDivideLoop
  2247.         jmp    FinishDivide
  2248. jDivideLoop:    jmp    DivideLoop
  2249. ;
  2250. ; If there was a carry out of the shift, we KNOW that fpacc must be
  2251. ; greater than fpop.  Handle that case down here.
  2252. ;
  2253. Greater:    dec    bp
  2254.         jz    FinishDivide
  2255.         stc
  2256.         rcl    Quotient[0], 1
  2257.         rcl    Quotient[2], 1
  2258.         rcl    Quotient[4], 1
  2259.         rcl    Quotient[6], 1
  2260.         sub    dx, fpop.mantissa[0]
  2261.         sbb    cx, fpop.mantissa[2]
  2262.         sbb    bx, di
  2263.         sbb    ax, si
  2264.         shl    dx, 1
  2265.         rcl    cx, 1
  2266.         rcl    bx, 1
  2267.         rcl    ax, 1
  2268.         jc    Greater
  2269.         dec    bp
  2270.         jz    FinishDivide
  2271.         jmp    DivideLoop
  2272. ;
  2273. ; Okay, clean everything up down here:
  2274. ;
  2275. FinishDivide:    mov    ax, Quotient[0]
  2276.         mov    fpacc.mantissa[0], ax
  2277.         mov    ax, Quotient[2]
  2278.         mov    fpacc.mantissa[2], ax
  2279.         mov    ax, Quotient[4]
  2280.         mov    fpacc.mantissa[4], ax
  2281.         mov    ax, Quotient[6]
  2282.         mov    fpacc.mantissa[6], ax
  2283. ;
  2284. QuitDiv:    ret
  2285.         assume    ds:nothing
  2286. div64        endp
  2287. ;
  2288. ;
  2289. ;
  2290. ;
  2291. ;
  2292. ;---------------------------------------------------------------------------
  2293. ;        Floating Point => TEXT (Output) conversion routines.
  2294. ;---------------------------------------------------------------------------
  2295. ;
  2296. ;
  2297. ;
  2298. ;
  2299. ; Power of ten tables used by the floating point I/O routines.
  2300. ;
  2301. ; Format for each entry (13 bytes):
  2302. ;
  2303. ; 1st through
  2304. ; 11th bytes    Internal FP format for this particular number.
  2305. ;
  2306. ; 12th &
  2307. ; 13th bytes:    Decimal exponent for this value.
  2308. ;
  2309. ;
  2310. ; This first table contains the negative powers of ten as follows:
  2311. ;
  2312. ;   for n:= 0 to 12 do
  2313. ;    entry [12-n] := 10 ** (-2 ** n)
  2314. ;   entry [13] := 1.0
  2315. ;
  2316. PotTbln         dw    9fdeh, 0d2ceh, 4c8h, 0a6ddh, 4ad8h    ; 1e-4096
  2317.         db    0                    ; Sign
  2318.         dw    -4096                    ; Dec Exponent
  2319. ;
  2320.         dw    2de4h, 3436h, 534fh, 0ceaeh, 656bh    ; 1e-2048
  2321.         db    0
  2322.         dw    -2048
  2323. ;
  2324.         dw    0c0beh, 0da57h, 82a5h, 0a2a6h, 72b5h    ; 1e-1024
  2325.         db    0
  2326.         dw    -1024
  2327. ;
  2328.         dw    0d21ch, 0db23h, 0ee32h, 9049h, 795ah    ; 1e-512
  2329.         db    0
  2330.         dw    -512
  2331. ;
  2332.         dw    193ah, 637ah, 4325h, 0c031h, 7cach    ; 1e-256
  2333.         db    0
  2334.         dw    -256
  2335. ;
  2336.         dw    0e4a1h, 64bch, 467ch, 0ddd0h, 7e55h    ; 1e-128
  2337.         db    0
  2338.         dw    -128
  2339. ;
  2340.         dw    0e9a5h, 0a539h, 0ea27h, 0a87fh, 7f2ah    ; 1e-64
  2341.         db    0
  2342.         dw    -64
  2343. ;
  2344.         dw    94bah, 4539h, 1eadh, 0cfb1h, 7f94h    ; 1e-32
  2345.         db    0
  2346.         dw    -32
  2347. ;
  2348.         dw    0e15bh, 0c44dh, 94beh, 0e695h, 7fc9h    ; 1e-16
  2349.         db    0
  2350.         dw    -16
  2351. ;
  2352.         dw    0cefdh, 8461h, 7711h, 0abcch, 7fe4h    ; 1e-8
  2353.         db    0
  2354.         dw    -8
  2355. ;
  2356.         dw    652ch, 0e219h, 1758h, 0d1b7h, 7ff1h    ; 1e-4
  2357.         db    0
  2358.         dw    -4
  2359. ;
  2360.         dw    0d70ah, 70a3h, 0a3dh, 0a3d7h, 7ff8h    ; 1e-2
  2361.         db    0
  2362.         dw    -2
  2363. ;
  2364. Div10Value    dw    0cccdh, 0cccch, 0cccch, 0cccch, 7ffbh    ; 1e-1
  2365.         db    0
  2366.         dw    -1
  2367. ;
  2368.         dw    0, 0, 0, 8000h, 7fffh            ; 1e0
  2369.         db    0
  2370.         dw    0
  2371. ;
  2372. ;
  2373. ; PotTblP- Power of ten table.  Holds powers of ten raised to positive
  2374. ;       powers of two;
  2375. ;
  2376. ;        i.e., x(12-n) = 10 ** (2 ** n) for 0 <= n <= 12.
  2377. ;              x(13) = 1.0
  2378. ;              x(-1) = 10 ** (2 ** -4096)
  2379. ;
  2380. ; There is a -1 entry since it is possible for the algorithm to back up
  2381. ; before the table.
  2382. ;
  2383.         dw    979bh, 8a20h, 5202h, 0c460h, 0b525h    ; 1e+4096
  2384.         db    0
  2385.         dw    4096
  2386. ;
  2387. PotTblP        dw    979bh, 8a20h, 5202h, 0c460h, 0b525h    ; 1e+4096
  2388.         db    0
  2389.         dw    4096
  2390. ;
  2391.         dw    5de5h, 0c53dh, 3b5dh, 9e8bh, 09a92h    ; 1e+2048
  2392.         db    0
  2393.         dw    2048
  2394. ;
  2395.         dw    0c17h, 8175h, 7586h, 0c976h, 08d48h    ; 1e+1024
  2396.         db    0
  2397.         dw    1024
  2398. ;
  2399.         dw    91c7h, 0a60eh, 0a0aeh, 0e319h, 086a3h    ; 1e+512
  2400.         db    0
  2401.         dw    512
  2402. ;
  2403.         dw    0de8eh, 9df9h, 0ebfbh, 0aa7eh, 08351h    ; 1e+256
  2404.         db    0
  2405.         dw    256
  2406. ;
  2407.         dw    8ce0h, 80e9h, 47c9h, 93bah, 081a8h    ; 1e+128
  2408.         db    0
  2409.         dw    128
  2410. ;
  2411.         dw    0a6d5h, 0ffcfh, 1f49h, 0c278h, 080d3h    ; 1e+64
  2412.         db    0
  2413.         dw    64
  2414. ;
  2415.         dw    0b59eh, 2b70h, 0ada8h, 9dc5h, 08069h    ; 1e+32
  2416.         db    0
  2417.         dw    32
  2418. ;
  2419.         dw    0, 400h, 0c9bfh, 8e1bh, 08034h        ; 1e+16
  2420.         db    0
  2421.         dw    16
  2422. ;
  2423.         dw    0, 0, 2000h, 0bebch, 08019h        ; 1e+8
  2424.         db    0
  2425.         dw    8
  2426. ;
  2427.         dw    0, 0, 0, 9c40h, 0800ch            ; 1e+4
  2428.         db    0
  2429.         dw    4
  2430. ;
  2431.         dw    0, 0, 0, 0c800h, 08005h            ; 1e+2
  2432.         db    0
  2433.         dw    2
  2434. ;
  2435.         dw    0, 0, 0, 0a000h, 08002h            ; 1e+1
  2436.         db    0
  2437.         dw    1
  2438. ;
  2439.         dw    0, 0, 0, 8000h, 7fffh            ; 1e0
  2440.         db    0
  2441.         dw    0
  2442. ;
  2443. ;
  2444. ;
  2445. ;
  2446. ;
  2447. ;
  2448. ;
  2449. ; SL_FTOA-    Converts extended precision value in FPACC to a decimal
  2450. ;        string.  AL contains the field width, AH contains the
  2451. ;        number of positions after the decimal point.  The format
  2452. ;        of the converted string is:
  2453. ;
  2454. ;            sd.e
  2455. ;
  2456. ;        where "s" is a single character which is either a space
  2457. ;        or "=", "e" is some number of digits which is equal to
  2458. ;        the value passed in AL, and "d" is the number of digits
  2459. ;        given by  (AL-AH-2).  If the field width is too small,
  2460. ;        this routine creates a string of "#" characters AH long.
  2461. ;
  2462. ;        ES:DI contains the address where we're supposed to put
  2463. ;        the resulting string.  This code assumes that there is
  2464. ;        sufficient memory to hold (AL+1) characters at this address.
  2465. ;
  2466. ;
  2467. ;
  2468.         public    sl_ftoa
  2469. sl_ftoa        proc    far
  2470.         push    di
  2471.         call    far ptr sl_ftoa2
  2472.         pop    di
  2473.         ret
  2474. sl_ftoa        endp
  2475. ;
  2476.         public    sl_ftoa2
  2477. sl_ftoa2    proc    far
  2478.         assume    ds:StdGrp
  2479. ;
  2480.         pushf
  2481.         push    ds
  2482.         push    ax
  2483.         push    bx
  2484.         push    cx
  2485.         push    dx
  2486.         push    si
  2487. ;
  2488.         cld
  2489.         mov    bx, StdGrp
  2490.         mov    ds, bx
  2491. ;
  2492. ; Save fpacc 'cause it gets munged.
  2493. ;
  2494.         push    fpacc.Mantissa [0]
  2495.         push    fpacc.Mantissa [2]
  2496.         push    fpacc.Mantissa [4]
  2497.         push    fpacc.Mantissa [6]
  2498.         push    fpacc.Exponent
  2499.         push    word ptr fpacc.Sign
  2500. ;
  2501.         mov    cx, ax        ;Save field width/dec pts here.
  2502. ;
  2503.         call    fpdigits    ;Convert fpacc to digit string.
  2504. ;
  2505. ; Round the string of digits to the number of significant digits we want to
  2506. ; display for this number:
  2507. ;
  2508.         mov    bx, DecExponent
  2509.         cmp    bx, 18
  2510.         jb    PosRS
  2511.         xor    bx, bx        ;Force to zero if negative or too big.
  2512. ;
  2513. PosRS:        add    bl, ch               ;Compute position where we should start
  2514.         adc    bh, 0        ; the rounding.
  2515.         inc    bx        ;Tweak next digit.
  2516.         cmp    bx, 18        ;Don't bother rounding if we have
  2517.         jae    RoundDone    ; more than 18 digits here.
  2518. ;
  2519. ; Add 5 to the digit after the last digit we want to print.  Then propogate
  2520. ; any overflow through the remaining digits.
  2521. ;
  2522.         mov    al, DecDigits [bx]
  2523.         add    al, 5
  2524.         mov    DecDigits [bx], al
  2525.         cmp    al, "9"
  2526.         jbe     RoundDone
  2527.         sub    DecDigits [bx], 10
  2528. RoundLoop:    dec    bx
  2529.         js    FirstDigit
  2530.         inc    DecDigits[bx]
  2531.         cmp    DecDigits[bx], "9"
  2532.         jbe    RoundDone
  2533.         sub    DecDigits[bx], 10
  2534.         jmp    RoundLoop
  2535. ;
  2536. ; If we hit the first digit in the string, we've got to shift all the
  2537. ; characters down one position and put a "1" in the first character
  2538. ; position.
  2539. ;
  2540. FirstDigit:     mov    bx, DecExponent
  2541.         cmp    bx, 18
  2542.         jb    FDOkay
  2543.         xor    bx, bx
  2544. ;
  2545. FDOkay:        mov    bl, ch
  2546.         mov    bh, 0
  2547.         inc    bx
  2548. FDLp:        mov    al, byte ptr DecDigits[bx-1]
  2549.         mov    DecDigits [bx], al
  2550.         dec    bx
  2551.         jnz    FDLp
  2552.         mov    DecDigits, "1"
  2553.         inc    DecExponent    ;Cause we just added a digit.
  2554. ;
  2555. RoundDone:
  2556. ;
  2557. ; See if we're dealing with values greater than one (abs) or between 0 & 1.
  2558. ;
  2559.         cmp    DecExponent, 0    ;Handle positive/negative exponents
  2560.         jge    PositiveExp    ; separately.
  2561. ;
  2562. ; Handle values between 0 & 1 here (negative powers of ten).
  2563. ;
  2564.         mov    dl, ch        ;Compute #'s width = DecPlaces+3
  2565.         add       dl, 3        ;Make room for "-0."
  2566.         jc    BadFieldWidth
  2567.         cmp    dl, 4
  2568.         jae    LengthOk
  2569.         mov    dl, 4        ;Minimum string is "-0.0"
  2570. LengthOK:    mov    al, ' '
  2571. PutSpcs2:       cmp    dl, cl
  2572.         jae    PS2Done
  2573.         stosb
  2574.         inc    dl
  2575.         jmp    PutSpcs2
  2576. ;
  2577. PS2Done:           mov    al, DecSign
  2578.         stosb
  2579.         mov    al, "0"        ;Output "0." before the number.
  2580.         stosb
  2581.         mov    al, "."
  2582.         stosb
  2583.         mov    ah, 0        ;Used to count output digits
  2584.         lea    bx, stdGrp:DecDigits ;Pointer to number string.
  2585. PutDigits2:    inc    DecExponent
  2586.         jns    PutTheDigit
  2587. ;
  2588. ; If the exponent value is still negative, output zeros because we've yet
  2589. ; to reach the beginning of the number.
  2590. ;
  2591. PutZero2:    mov    al, '0'
  2592.         stosb
  2593.         jmp    TestDone2
  2594. ;
  2595. PutTheDigit:    cmp    ah, 18        ;If more than 18 digits so far, just
  2596.         jae    PutZero2    ; output zeros.
  2597. ;
  2598.         mov    al, [bx]
  2599.         inc    bx
  2600.         stosb
  2601. ;
  2602. TestDone2:    inc    ah
  2603.         dec    ch
  2604.         jnz     PutDigits2
  2605.         mov    byte ptr es:[di], 0
  2606.         jmp    ftoaDone
  2607. ;
  2608. ;
  2609. ; Okay, we've got a positive exponent here.  First, let's adjust the field
  2610. ; width value (in CH) so that it includes the sign and possible decimal point.
  2611. ;
  2612. PositiveExp:    mov    dx, DecExponent    ;Get actual # of digits to left of "."
  2613.         inc    dx        ;Allow for sign and the fact that there
  2614.         inc    dx        ; is always one digit to left of ".".
  2615.         cmp    ch, 0        ;# of chars after "." = 0?
  2616.         je    NoDecPt
  2617.         add    dl, ch        ;Add in number of chars after "."
  2618.         adc    dh, 0
  2619.         inc    dx        ;Make room for "."
  2620. NoDecPt:
  2621. ;
  2622. ;
  2623. ; Make sure the field width is bigger than the number of decimal places to
  2624. ; print.
  2625. ;
  2626.         cmp    cl, ch
  2627.         jb    BadFieldWidth
  2628. ;
  2629. ;
  2630. ; Okay, now see if the user is trying to print a value which is too large
  2631. ; to fit in the given field width:
  2632. ;
  2633.         cmp    dh, 0
  2634.         jne    BadFieldWidth    ;Sorry, no output >= 256 chars.
  2635.         cmp    dl, cl        ;Need field width > specified FW?
  2636.         jbe    GoodFieldWidth
  2637. ;
  2638. ; If we get down here, then we've got a number which will not fit in the
  2639. ; specified field width.  Fill the string with #'s (sorta like FORTRAN).
  2640. ;
  2641. BadFieldWidth:    mov    ch, 0        ;Set CX=field width.
  2642.         mov    al, "#"
  2643.     rep    stosb
  2644.         mov    byte ptr es:[di], 0
  2645.         jmp    ftoaDone
  2646. ;
  2647. ;
  2648. ; Print any necessary spaces in front of the number.
  2649. ;
  2650. GoodFieldWidth:    call    PutSpaces
  2651. ;
  2652. ; Output the sign character (" " or "-"):
  2653. ;
  2654.         mov    al, DecSign
  2655.         stosb
  2656. ;
  2657. ; Okay, output the digits for this number here.
  2658. ;
  2659.         mov    ah, 0        ;Counts off output characters.
  2660.         lea    bx, stdgrp:DecDigits ;Pointer to digit string.
  2661.         mov    cl, ch        ;CX := # of chars after "."
  2662.         mov    ch, 0               ; plus number of characters before
  2663.         add    cx, DecExponent    ; the ".".
  2664.         inc    cx        ;Always at least one digit before "."
  2665. OutputLp:    cmp    ah, 18        ;Exceeded 18 digits?
  2666.         jae    PutZeros
  2667.         mov    al, [bx]
  2668.         inc    bx
  2669.         jmp    PutChar
  2670. ;
  2671. PutZeros:    mov    al, '0'
  2672. PutChar:    stosb
  2673.         cmp    DecExponent, 0
  2674.         jne    DontPutPoint
  2675.         mov    al, '.'
  2676.         stosb
  2677. ;
  2678. DontPutPoint:    dec    DecExponent
  2679.         inc    ah
  2680.         loop    OutputLp
  2681.         mov    byte ptr es:[di], 0     ;Output the zero byte.
  2682. ;
  2683. ftoaDone:    pop    word ptr fpacc.Sign
  2684.         pop    fpacc.Exponent
  2685.         pop    fpacc.Mantissa [6]
  2686.         pop    fpacc.Mantissa [4]
  2687.         pop    fpacc.Mantissa [2]
  2688.         pop    fpacc.Mantissa [0]
  2689.         pop    si
  2690.         pop    dx
  2691.         pop    cx
  2692.         pop    bx
  2693.         pop    ax
  2694.         pop    ds
  2695.         popf
  2696.         ret
  2697. sl_ftoa2    endp
  2698. ;
  2699. ;
  2700. ;
  2701. ;
  2702. ; Okay, now we need to insert any necessary leading spaces.  We need to
  2703. ; put (FieldWidth - ActualWidth) spaces before the string of digits.
  2704. ;
  2705. PutSpaces    proc    near
  2706.         cmp    dl, cl        ;See if print width >= field width
  2707.         jae    NoSpaces
  2708.         mov    ah, cl
  2709.         sub    ah, dl        ;Compute # of spaces to print.
  2710.         mov    al, ' '
  2711. PSLp:        stosb
  2712.         dec    ah
  2713.         jnz    PSLp
  2714. NoSpaces:    ret
  2715. PutSpaces    endp
  2716. ;
  2717. ;
  2718. ;
  2719. ;
  2720. ;
  2721. ;
  2722. ;
  2723. ;
  2724. ;
  2725. ;
  2726. ;
  2727. ;
  2728. ;
  2729. ;
  2730. ; SL_ETOA-    Converts value in FPACC to exponential form.  AL contains
  2731. ;        the number of print positions.  ES:DI points to the array
  2732. ;        which will hold this string (it must be at least AL+1 chars
  2733. ;        long).
  2734. ;
  2735. ;        The output string takes the format:
  2736. ;
  2737. ;        {" "|-} [0-9] "." [0-9]* "E" [+|-] [0-9]{2,4}
  2738. ;
  2739. ;        (The term "[0-9]{2,4}" means either two or four digits)
  2740. ;
  2741. ;        AL must be at least eight or this code outputs #s.
  2742. ;
  2743.         public    sl_etoa
  2744. sl_etoa        proc    far
  2745.         push    di
  2746.         call    far ptr sl_etoa2
  2747.         pop    di
  2748.         ret
  2749. sl_etoa        endp
  2750. ;
  2751. ;
  2752.         public    sl_etoa2
  2753. sl_etoa2    proc    far
  2754.         assume    ds:StdGrp
  2755. ;
  2756.         pushf
  2757.         push    ds
  2758.         push    ax
  2759.         push    bx
  2760.         push    cx
  2761.         push    si
  2762. ;
  2763.         cld
  2764.         mov    bx, StdGrp
  2765.         mov    ds, bx
  2766. ;
  2767.         push    fpacc.Mantissa [0]
  2768.         push    fpacc.Mantissa [2]
  2769.         push    fpacc.Mantissa [4]
  2770.         push    fpacc.Mantissa [6]
  2771.         push    fpacc.Exponent
  2772.         push    word ptr fpacc.Sign
  2773. ;
  2774.         call    fpdigits
  2775. ;
  2776. ; See if we have sufficient room for the number-
  2777. ;
  2778.         mov    ah, 0
  2779.         mov    cx, ax
  2780. ;
  2781. ; Okay, take out spots for sign, ".", "E", sign, and at least four exponent
  2782. ; digits and the exponent's sign:
  2783. ;
  2784. Subtract2:    sub    ax, 8
  2785.         jc    BadEWidth
  2786.         jnz    DoTheRound    ;Make sure at least 1 digit left!
  2787. ;
  2788. BadEWidth:    mov    ch, 0
  2789.         mov    al, "#"
  2790.     rep    stosb
  2791.         mov    al, 0
  2792.         stosb
  2793.         jmp    etoaDone
  2794. ;
  2795. ; Round the number to the specified number of places.
  2796. ;
  2797. DoTheRound:    mov    ch, al        ;# of decimal places is # of posns.
  2798.         mov    bl, ch               ;Compute position where we should start
  2799.         mov    bh, 0        ; the rounding.
  2800.         cmp    bx, 18        ;Don't bother rounding if we have
  2801.         jae    eRoundDone    ; more than 18 digits here.
  2802. ;
  2803. ; Add 5 to the digit after the last digit we want to print.  Then propogate
  2804. ; any overflow through the remaining digits.
  2805. ;
  2806.         mov    al, DecDigits [bx]
  2807.         add    al, 5
  2808.         mov    DecDigits [bx], al
  2809.         cmp    al, "9"
  2810.         jbe     eRoundDone
  2811.         sub    DecDigits [bx], 10
  2812. eRoundLoop:    dec    bx
  2813.         js    eFirstDigit
  2814.         inc    DecDigits[bx]
  2815.         cmp    DecDigits[bx], "9"
  2816.         jbe    eRoundDone
  2817.         sub    DecDigits[bx], 10
  2818.         jmp    eRoundLoop
  2819. ;
  2820. ; If we hit the first digit in the string, we've got to shift all the
  2821. ; characters down one position and put a "1" in the first character
  2822. ; position.
  2823. ;
  2824. eFirstDigit:    mov    bl, ch
  2825.         mov    bh, 0
  2826.         inc    bx
  2827. eFDLp:        mov    al, byte ptr DecDigits[bx-1]
  2828.         mov    DecDigits [bx], al
  2829.         dec    bx
  2830.         jnz    eFDLp
  2831.         mov    DecDigits, "1"
  2832.         inc    DecExponent    ;Cause we just added a digit.
  2833. ;
  2834. eRoundDone:
  2835. ;
  2836. ; Okay, output the value here.
  2837. ;
  2838.         mov    cl, ch        ;Set CX=Number of output chars
  2839.         mov    ch, 0
  2840.         mov    al, DecSign
  2841.         stosb
  2842.         lea    si, stdgrp:DecDigits
  2843.         movsb            ;Output first char.
  2844.         dec    cx        ;See if we're done!
  2845.         jz    PutExponent
  2846. ;
  2847. ; Output the fractional part here
  2848. ;
  2849.         mov    al, "."
  2850.         stosb
  2851.         mov    ah, 17        ;Max # of chars to output.
  2852. PutFractional:    cmp    ah, 0
  2853.         jz    NoMoreDigs
  2854.         movsb
  2855.         dec    ah
  2856.         jmp    NextFraction
  2857. ;
  2858. ; If we've output more than 18 digits, just output zeros.
  2859. ;
  2860. NoMoreDigs:    mov    al, "0"
  2861.         stosb
  2862. ;
  2863. NextFraction:    loop    PutFractional
  2864. PutExponent:    mov    al, "E"
  2865.         stosb
  2866.         mov    al, "+"
  2867.         cmp    DecExponent, 0
  2868.         jge    NoNegExp
  2869.         mov    al, "-"
  2870.         neg    DecExponent
  2871. ;
  2872. NoNegExp:    stosb
  2873.         mov    ax, DecExponent
  2874.         cwd            ;Sets DX := 0.
  2875.         mov    cx, 1000
  2876.         div    cx
  2877.         or    al, "0"
  2878.         stosb            ;Output 1000's digit
  2879.         xchg    ax, dx
  2880.         cwd
  2881.         mov    cx, 100
  2882.         div    cx
  2883.         or    al, "0"        ;Output 100's digit
  2884.         stosb
  2885.         xchg    ax, dx
  2886.         cwd
  2887.         mov    cx, 10
  2888.         div    cx
  2889.         or    al, "0"        ;Output 10's digit
  2890.         stosb
  2891.         xchg    ax, dx
  2892.         or    al, "0"        ;Output 1's digit
  2893.         stosb
  2894.         mov    byte ptr es:[di], 0    ;Output zero byte.
  2895. ;
  2896. etoaDone:    pop    word ptr fpacc.Sign
  2897.         pop    fpacc.Exponent
  2898.         pop    fpacc.Mantissa [6]
  2899.         pop    fpacc.Mantissa [4]
  2900.         pop    fpacc.Mantissa [2]
  2901.         pop    fpacc.Mantissa [0]
  2902.         pop    si
  2903.         pop    cx
  2904.         pop    bx
  2905.         pop    ax
  2906.         pop    ds
  2907.         popf
  2908.         ret
  2909. sl_etoa2    endp
  2910. ;
  2911. ;
  2912. ;
  2913. ;
  2914. ;
  2915. ; FPDigits- Converts the floating point number in FPACC to a string of
  2916. ;        digits (in DecDigits), an integer exponent value (DecExp),
  2917. ;        and a sign character (DecSign).  The decimal point is assumed
  2918. ;        to be between the first and second characters in the string.
  2919. ;
  2920. FPDigits    proc    near
  2921.         assume    ds:StdGrp
  2922.         push    ds
  2923.         push    ax
  2924.         push    bx
  2925.         push    cx
  2926.         push    dx
  2927.         push    di
  2928.         push    si
  2929. ;
  2930.         mov    ax, seg StdGrp
  2931.         mov    ds, ax
  2932. ;
  2933. ; First things first, see if this value is zero:
  2934. ;
  2935.         mov    ax, fpacc.exponent
  2936.         or    ax, fpacc.Mantissa [0]
  2937.         or    ax, fpacc.Mantissa [2]
  2938.         or    ax, fpacc.Mantissa [4]
  2939.         or    ax, fpacc.Mantissa [6]
  2940.         jnz    fpdNotZero
  2941. ;
  2942. ; Well, it's zero.  Handle this as a special case:
  2943. ;
  2944.         mov    ax, 3030h        ;"00"
  2945.         mov    word ptr DecDigits[0], ax
  2946.         mov    word ptr DecDigits[2], ax
  2947.         mov    word ptr DecDigits[4], ax
  2948.         mov    word ptr DecDigits[6], ax
  2949.         mov    word ptr DecDigits[8], ax
  2950.         mov    word ptr DecDigits[10], ax
  2951.         mov    word ptr DecDigits[12], ax
  2952.         mov    word ptr DecDigits[14], ax
  2953.         mov    word ptr DecDigits[16], ax
  2954.         mov    word ptr DecDigits[18], ax
  2955.         mov    word ptr DecDigits[20], ax
  2956.         mov    word ptr DecDigits[22], ax
  2957.         mov    DecExponent, 0
  2958.         mov    DecSign, ' '
  2959.         jmp    fpdDone
  2960. ;
  2961. ; If the number is not zero, first fix up the sign:
  2962. ;
  2963. fpdNotZero:    mov    DecSign, ' '        ;Assume it's postive
  2964.         cmp    fpacc.Sign, 0
  2965.         jns    WasPositive
  2966.         mov    DecSign, '-'
  2967.         mov    fpacc.Sign, 0        ;Take ABS(fpacc).
  2968. ;
  2969. ; This conversion routine is fairly standard.  See Neil Graham's
  2970. ; "Microprocessor Programming for Computer Hobbyists" for the gruesome
  2971. ; details.  Basically, it first gets the number between 1 & 10 by successively
  2972. ; multiplying (or dividing) by ten.  For each multiply by 10 this code
  2973. ; decrements DecExponent by one.  For each division by ten this code
  2974. ; increments DecExponent by one.  Upon getting the value between 1 & 10
  2975. ; DecExponent contains the integer equivalent of the exponent.  The
  2976. ; following code does this.
  2977. ;
  2978. ; Note: if the value falls between 1 & 10, then the exponent portion of
  2979. ;    fpacc will lie between 7fffh and 8002h.
  2980. ;
  2981. WasPositive:    mov    DecExponent, 0        ;Initialize exponent.
  2982. ;
  2983. ; Quick test to see if we're already less than 10.
  2984. ;
  2985. WhlBgrThan10:    cmp    fpacc.Exponent, 8002h    ;See if fpacc > 10
  2986.         jb    WhlLessThan1
  2987.         ja    IsGtrThan10
  2988. ;
  2989. ; If the exponent is equal to 8002h, then we could have a number in the
  2990. ; range 8 <= n < 16.  Let's ignore values less than 10.
  2991. ;
  2992.         cmp    byte ptr fpacc.Mantissa [7], 0a0h
  2993.         jb    WhlLessThan1
  2994. ;
  2995. ; If it's bigger than ten we could perform successive divisions by ten.
  2996. ; This, however, would be slow, inaccurate, and disgusting.  The following
  2997. ; loop skips through the positive powers of ten (PotTblP) until it finds
  2998. ; someone with an exponent *less* than fpacc.  Upon finding such a value,
  2999. ; this code divides fpacc by the corresponding entry in PotTblN.  This is
  3000. ; equivalent to *dividing* by the entry in PotTblP.  Note: this code only
  3001. ; compares exponents.  Therefore, it is quite possible that we will divide
  3002. ; by a number slightly larger than fpacc (since the mantissa of the table
  3003. ; entry could be larger than the mantissa of fpacc while their exponents
  3004. ; are equal).  This will produce a result slightly less than one.  This is
  3005. ; okay in this case because the code which handles values between 0 & 1
  3006. ; follows and will correct this oversight.
  3007. ;
  3008. IsGtrThan10:    mov    bx, -13            ;Index into PotTblP
  3009.         mov    ax, fpacc.Exponent
  3010. WhlBgrLp1:    add    bx, 13
  3011.         cmp    ax, PotTblP [bx] + 8    ;Compare exponent values.
  3012.         jb    WhlBgrLp1        ;Go to next entry if less.
  3013. ;
  3014. ; Okay, we found the first table entry whose exponent is less than or
  3015. ; equal to the fpacc exponent.  Multiply by the corresonding PotTblN
  3016. ; value here (which simulates a divide).
  3017. ;
  3018.         call    nTbl2FPOP
  3019.         mov    ax, PotTblP [bx] + 11    ;Adjust DecExponent
  3020.         add    DecExponent, ax
  3021.         call    sl_fMUL            ;Divide by appropriate power.
  3022.         mov    ax, fpacc.Exponent
  3023.         cmp    ax, 8002h        ;See if fpacc > 10
  3024.         jae    WhlBgrLp1
  3025. ;
  3026. ;
  3027. ; Once we get the number below 10 (or if it was below 10 to begin with,
  3028. ; drop down here and boost it up to the point where it is >= 1.
  3029. ;
  3030. ; This code is similar to the above-  It successively multiplies by 10
  3031. ; (actually, powers of ten) until the number is in the range 1..10.
  3032. ; This code is not as sloppy as the code above because we don't have any
  3033. ; code below this to clean up the sloppiness.  Indeed, this code has to
  3034. ; be careful because it is cleaning up the sloppiness of the code above.
  3035. ;
  3036. ;
  3037. WhlLessThan1:    cmp    fpacc.Exponent, 7fffh    ;See if fpacc < 1
  3038.         jae    NotLessThan1
  3039. ;
  3040.         mov    bx, -13            ;Index into PotTblN
  3041. WhlLessLp2:    mov    ax, fpacc.Exponent
  3042. WhlLessLp1:    add    bx, 13
  3043.         cmp    ax, PotTblN [bx] + 8    ;Compare exponent values.
  3044.         ja    WhlLessLp1        ;Go to next entry if less.
  3045. ;
  3046. ; Okay, we found the first table entry whose exponent is greater than or
  3047. ; equal to the fpacc exponent.  Unlike the code above, we cannot simply
  3048. ; multiply by the corresponding entry in PotTblP at this point.  If the
  3049. ; exponents were equal, we need to compare the mantissas and make sure we're
  3050. ; not multiplying by a table entry which is too large.
  3051. ;
  3052.         jne    OkayToMultiply
  3053. ;
  3054. ; If the exponents are the same, we need to compare the mantissas.  The
  3055. ; table entry cannot be larger than fpacc;  if it is, we'll wind up with
  3056. ; an endless loop oscillating between a couple of values.
  3057. ;
  3058.         mov    ax, fpacc.Mantissa [6]
  3059.         cmp    ax, PotTblN [bx] + 6
  3060.         ja      WhlLessLp2
  3061.         jb    OkayToMultiply
  3062.         mov    ax, fpacc.Mantissa [4]
  3063.         cmp    ax, PotTblN [bx] + 4
  3064.         ja    WhlLessLp2
  3065.         jb    OkayToMultiply
  3066.         mov    ax, fpacc.Mantissa [2]
  3067.         cmp    ax, PotTblN [bx] + 2
  3068.         ja    WhlLessLp2
  3069.         jb    OkayToMultiply
  3070.         mov    ax, fpacc.Mantissa [0]
  3071.         cmp    ax, PotTblN [bx]
  3072.         ja    WhlLessLp2
  3073. ;
  3074. ;
  3075. OkayToMultiply:    call    pTbl2FPOP
  3076.         mov    ax, PotTblN [bx] + 11    ;Adjust DecExponent
  3077.         add    DecExponent, ax
  3078.         call    sl_fMUL            ;Multiply by appropriate power.
  3079.         jmp    WhlLessThan1        ;Repeat till in range 1..10.
  3080. ;
  3081. ;
  3082. ; The above code tries to get fpacc in the range 1 <= n < 10.
  3083. ; However, it doesn't quite accomplish this.  In fact, it gets the value
  3084. ; into the range 1 <= n < 16.  This next section checks to see if the value
  3085. ; is greater than ten.  If it is, it does one more division by ten.
  3086. ;
  3087. NotLessThan1:    cmp    fpacc.Exponent, 8002h    ;10..15 only if exp = 8002h.
  3088.         jb    Not10_15
  3089. ;
  3090. ; For fpacc to be in the range 10..15 the mantissa must be greater than or
  3091. ; equal to 0A000 0000 0000 0000.
  3092. ;
  3093.         cmp    byte ptr fpacc.Mantissa [7], 0a0h
  3094.         jb    Not10_15
  3095. ;
  3096. ; Okay, the mantissa is greater than or equal to ten.  Divide by ten once
  3097. ; more to fix this up.
  3098. ;
  3099.         lea    bx, stdgrp:Div10Value
  3100.         sub    bx, offset stdgrp:PotTblN
  3101.         call    pTbl2FPOP
  3102.         call    sl_fMUL            ;Multiply by appropriate power.
  3103.         inc    DecExponent
  3104. ;
  3105. ; Well, we've managed to compute the decimal exponent value and normalize
  3106. ; the number to the range 1 <= n < 10.
  3107. ;
  3108. ; Make sure the upper four bits contain a BCD value.  This may entail
  3109. ; shifting data to the right.
  3110. ;
  3111. Not10_15:    mov    si, fpacc.Mantissa [0]    ;We'll use these a lot, so
  3112.         mov    di, fpacc.Mantissa [2]    ; put them into registers.
  3113.         mov    cx, fpacc.Mantissa [4]
  3114.         mov    dx, fpacc.Mantissa [6]
  3115. SHRLp:        cmp    fpacc.Exponent, 8002h
  3116.         jae    PossiblyRound
  3117.         shr    dx, 1
  3118.         rcr    cx, 1
  3119.         rcr    di, 1
  3120.         rcr    si, 1
  3121.         inc    fpacc.Exponent
  3122.         jmp     SHRLp
  3123. ;
  3124. ; May have to round the number if we wound up with a value between 10..15.
  3125. ;
  3126. ; Note: 0.5 e -18 is 7fc5 b8xxxxxxxx...   If we adjust this value so that
  3127. ;    the exponent is 7fffh, we keep only the top five bits (10111).  The
  3128. ;    following code adds this value (17h) to the mantiss to round as
  3129. ;    appropriate.
  3130. ;
  3131. PossiblyRound:    add    si, 2h
  3132.         jnc    ChkTooBig
  3133.         inc    di
  3134.         jnz    ChkTooBig
  3135.         inc    cx
  3136.         jnz    ChkTooBig
  3137.         inc    dx
  3138. ;
  3139. ; If we fall through to this point, it's quite possible that we will produce
  3140. ; a value greater than or equal to ten.  Handle that possibility here.
  3141. ;
  3142. ChkTooBig:    cmp    dh, 0a0h
  3143.         jb    NoOvrflw
  3144. ;
  3145. ; Well, overflow occurred, clean it up.
  3146. ;
  3147.         xor    ax, ax
  3148.         mov    si, ax
  3149.         mov    di, ax
  3150.         mov    cx, ax
  3151.         mov    dx, 1000h
  3152.         inc    DecExponent
  3153. ;
  3154. ; Finally!  We're at the point where we can start stripping off the
  3155. ; digits from the number
  3156. ;
  3157. NoOvrflw:    lea    bx, stdgrp:DecDigits
  3158.         xor    ax, ax
  3159. ;
  3160. StripDigits:    mov    al, dh
  3161.         shr    ax, 1
  3162.         shr    ax, 1
  3163.         shr     ax, 1
  3164.         shr    ax, 1
  3165.         or    al, '0'
  3166.         mov    [bx], al
  3167.         inc    bx
  3168.         cmp    bx, offset stdgrp:DecDigits+18
  3169.         jae    fpdDone
  3170. ;
  3171. ; Remove the digit we just stripped:
  3172. ;
  3173.         and    dh, 0fh
  3174. ;
  3175. ; Multiply the mantissa by ten (using shifts and adds):
  3176. ;
  3177.         shl    si, 1
  3178.         rcl    di, 1
  3179.         rcl    cx, 1
  3180.         rcl    dx, 1
  3181.         mov    fpacc.Mantissa [0], si    ;Save *2
  3182.         mov    fpacc.Mantissa [2], di
  3183.         mov    fpacc.Mantissa [4], cx
  3184.         mov    fpacc.Mantissa [6], dx
  3185. ;
  3186.         shl    si, 1            ;*4
  3187.         rcl    di, 1
  3188.         rcl    cx, 1
  3189.         rcl    dx, 1
  3190. ;
  3191.         shl    si, 1            ;*8
  3192.         rcl    di, 1
  3193.         rcl    cx, 1
  3194.         rcl    dx, 1
  3195. ;
  3196.         add    si, fpacc.Mantissa [0]    ;*10
  3197.         adc    di, fpacc.Mantissa [2]
  3198.         adc    cx, fpacc.Mantissa [4]
  3199.         adc    dx, fpacc.Mantissa [6]
  3200.         jmp     StripDigits
  3201. ;
  3202. fpdDone:        pop    si
  3203.         pop    di
  3204.         pop    dx
  3205.         pop    cx
  3206.         pop    bx
  3207.         pop    ax
  3208.         pop    ds
  3209.         ret
  3210. FPDigits    endp
  3211. ;
  3212. ;
  3213. ;
  3214. ; nTbl2FPOP- BX is an index into PotTbln.  This routine fetches the entry
  3215. ;         at that index and copies it into FPOP.
  3216. ;
  3217. nTbl2FPOP    proc    near
  3218.         mov    ax, PotTbln [bx] + 8
  3219.         mov    fpop.Exponent, ax
  3220.         mov    ax, PotTbln [bx]
  3221.         mov    fpop.Mantissa [0], ax
  3222.         mov    ax, PotTbln [bx] + 2
  3223.         mov    fpop.Mantissa [2], ax
  3224.         mov    ax, PotTbln [bx] + 4
  3225.         mov    fpop.Mantissa [4], ax
  3226.         mov    ax, PotTbln [bx] + 6
  3227.         mov    fpop.Mantissa [6], ax
  3228.         mov    fpop.Sign, 0        ;All entries are positive.
  3229.         ret
  3230. nTbl2FPOP    endp
  3231. ;
  3232. ; pTbl2FPOP- Same as above except the data comes from PotTblP.
  3233. ;
  3234. pTbl2FPOP    proc    near
  3235.         mov    ax, PotTblp [bx] + 8
  3236.         cmp    ax, 7fffh
  3237.         jne    DoPTFPOP
  3238.         sub    bx, 13            ;Special case if we hit 1.0
  3239.         mov    ax, PotTblp [bx] + 8
  3240. ;
  3241. DoPTFPOP:    mov    fpop.Exponent, ax
  3242.         mov    ax, PotTblp [bx]
  3243.         mov    fpop.Mantissa [0], ax
  3244.         mov    ax, PotTblp [bx] + 2
  3245.         mov    fpop.Mantissa [2], ax
  3246.         mov    ax, PotTblp [bx] + 4
  3247.         mov    fpop.Mantissa [4], ax
  3248.         mov    ax, PotTblp [bx] + 6
  3249.         mov    fpop.Mantissa [6], ax
  3250.         mov    fpop.Sign, 0        ;All entries are positive.
  3251.         ret
  3252. pTbl2FPOP    endp
  3253. ;
  3254. ;
  3255. ;
  3256. ;
  3257. ;
  3258. ;----------------------------------------------------------------------------
  3259. ;           Text => Floating Point (Input) Conversion Routines
  3260. ;----------------------------------------------------------------------------
  3261. ;
  3262. ;
  3263. ; ATOF-        ES:DI points at a string containing (hopefully) a numeric
  3264. ;        value in floating point format.  This routine converts that
  3265. ;        value to a number and puts the result in fpacc.  Allowable
  3266. ;        strings are described by the following regular expression:
  3267. ;
  3268. ;        {" "}* {+ | -} ( ([0-9]+ {"." [0-9]*}) | ("." [0-9]+)}
  3269. ;                {(e | E) {+ | -} [0-9] {[0-9]*}}
  3270. ;
  3271. ; "{}" denote optional items.
  3272. ; "|"  denotes OR.
  3273. ; "()" groups items together.
  3274. ;
  3275. ;
  3276. shl64        macro
  3277.         shl    bx, 1
  3278.         rcl    cx, 1
  3279.         rcl    dx, 1
  3280.         rcl    si, 1
  3281.         endm
  3282. ;
  3283.         public    sl_ATOF
  3284. sl_ATOF        proc    far
  3285.         assume    ds:StdGrp, es:nothing
  3286. ;
  3287.         push    ds
  3288.         push    ax
  3289.         push    bx
  3290.         push    cx
  3291.         push    dx
  3292.         push    si
  3293.         push    di
  3294.         push    bp
  3295. ;
  3296.         mov    ax, StdGrp
  3297.         mov    ds, ax
  3298. ;
  3299. ;
  3300. ; First, skip any leading spaces:
  3301. ;
  3302.         mov    ah, " "
  3303. SkipBlanks:    mov    al, es:[di]
  3304.         inc    di
  3305.         cmp    al, ah
  3306.         je    SkipBlanks
  3307. ;
  3308. ; Check for + or -.
  3309. ;
  3310.         cmp    al, "-"
  3311.         jne    TryPlusSign
  3312.         mov    fpacc.Sign, 80h
  3313.         jmp    EatSignChar
  3314. ;
  3315. TryPlusSign:    mov    fpacc.Sign, 0        ;If not "-", then positive.
  3316.         cmp    al, "+"
  3317.         jne    NotASign
  3318. EatSignChar:    mov    al, es:[di]        ;Get char beyond sign
  3319.         inc    di
  3320. ;
  3321. ; Init some important local vars:
  3322. ; Note: BP contains the number of significant digits processed thus far.
  3323. ;
  3324. NotASign:    mov    DecExponent, 0
  3325.         xor    bx, bx            ;Init 64 bit result.
  3326.         mov    cx, bx
  3327.         mov    dx, bx
  3328.         mov    si, bx
  3329.         mov    bp, bx
  3330.         mov    ah, bh
  3331. ;
  3332. ; First, eliminate any leading zeros (which do not count as significant
  3333. ; digits):
  3334. ;
  3335. Eliminate0s:    cmp    al, "0"
  3336.         jne    EndOfZeros
  3337.         mov    al, es:[di]
  3338.         inc    di
  3339.         jmp    Eliminate0s
  3340. ;
  3341. ; When we reach the end of the leading zeros, first check for a decimal
  3342. ; point.  If the number is of the form "0---0.0000" we need to get rid
  3343. ; of the zeros after the decimal point and not count them as significant
  3344. ; digits.
  3345. ;
  3346. EndOfZeros:    cmp    al, "."
  3347.         jne    WhileDigits
  3348. ;
  3349. ; Okay, the number is of the form ".xxxxx".  Strip all zeros immediately
  3350. ; after the decimal point.
  3351. ;
  3352. Right0s:    mov    al, es:[di]
  3353.         inc    di
  3354.         cmp    al, "0"
  3355.         jne    FractionPart
  3356.         dec    DecExponent        ;Not significant digit, but
  3357.         jmp    Right0s            ; affects exponent.
  3358. ;
  3359. ;
  3360. ; If the number is of the form "yyy.xxxx" (where y <> 0) then process it
  3361. ; down here.
  3362. ;
  3363. WhileDigits:    sub    al, "0"
  3364.         cmp    al, 10
  3365.         jae    NotADigit
  3366. ;
  3367. ; See if we've processed more than 19 sigificant digits:
  3368. ;
  3369.         cmp    bp, 19            ;Too many significant digits?
  3370.         jae    DontMergeDig
  3371. ;
  3372. ; Multiply value in (si, dx, cx, bx) by ten:
  3373. ;
  3374.         shl64
  3375.         mov    fpacc.Mantissa [0], bx
  3376.         mov    fpacc.Mantissa [2], cx
  3377.         mov    fpacc.Mantissa [4], dx
  3378.         mov    fpacc.Mantissa [6], si
  3379.         shl64
  3380.         shl64
  3381.         add    bx, fpacc.Mantissa [0]
  3382.         adc    cx, fpacc.Mantissa [2]
  3383.         adc    dx, fpacc.Mantissa [4]
  3384.         adc    si, fpacc.Mantissa [6]
  3385. ;
  3386. ; Add in current digit:
  3387. ;
  3388.         add    bx, ax
  3389.         jnc     GetNextDig
  3390.         inc    cx
  3391.         jne    GetNextDig
  3392.         inc    dx
  3393.         jne    GetNextDig
  3394.         inc    si
  3395.         jmp    GetNextDig
  3396. ;
  3397. DontMergeDig:    inc    DecExponent
  3398. GetNextDig:    inc    bp            ;Yet another significant dig.
  3399.         mov    al, es:[di]
  3400.         inc    di
  3401.         jmp    WhileDigits
  3402. ;
  3403. ;
  3404. ; Check to see if there is a decimal point here:
  3405. ;
  3406. NotADigit:    cmp    al, "."-"0"
  3407.         jne    NotADecPt
  3408.         mov    al, es:[di]
  3409.         inc    di
  3410. ;
  3411. ; Okay, process the digits to the right of the decimal point here.
  3412. ;
  3413. FractionPart:    sub    al, "0"
  3414.         cmp    al, 10
  3415.         jae    NotADecPt
  3416. ;
  3417. ; See if we've processed more than 19 sigificant digits:
  3418. ;
  3419.         cmp    bp, 19            ;Too many significant digits?
  3420.         jae    DontMergeDig2
  3421. ;
  3422. ; Multiply value in (si, dx, cx, bx) by ten:
  3423. ;
  3424.         dec    DecExponent        ;Raise by a power of ten.
  3425.         shl64
  3426.         mov    fpacc.Mantissa [0], bx
  3427.         mov    fpacc.Mantissa [2], cx
  3428.         mov    fpacc.Mantissa [4], dx
  3429.         mov    fpacc.Mantissa [6], si
  3430.         shl64
  3431.         shl64
  3432.         add    bx, fpacc.Mantissa [0]
  3433.         adc    cx, fpacc.Mantissa [2]
  3434.         adc    dx, fpacc.Mantissa [4]
  3435.         adc    si, fpacc.Mantissa [6]
  3436. ;
  3437. ; Add in current digit:
  3438. ;
  3439.         add    bx, ax
  3440.         jnc     DontMergeDig2
  3441.         inc    cx
  3442.         jne    DontMergeDig2
  3443.         inc    dx
  3444.         jne    DontMergeDig2
  3445.         inc    si
  3446. ;
  3447. DontMergeDig2:    inc    bp            ;Yet another significant dig.
  3448.         mov    al, es:[di]
  3449.         inc    di
  3450.         jmp    FractionPart
  3451. ;
  3452. ; Process the exponent down here
  3453. ;
  3454. NotADecPt:    cmp    al, "e"-"0"
  3455.         je    IsExponent
  3456.         cmp    al, "E"-"0"
  3457.         jne    NormalizeInput
  3458. ;
  3459. ; Okay, we just saw the "E" character, now read in the exponent value
  3460. ; and add it into DecExponent.
  3461. ;
  3462. IsExponent:    mov    ExpSign, 0        ;Assume positive exponent.
  3463.         mov    al, es:[di]
  3464.         inc    di
  3465.         cmp    al, "+"
  3466.         je    EatExpSign
  3467.         cmp    al, "-"
  3468.         jne    ExpNotNeg
  3469.         mov    ExpSign, 1        ;Exponent is negative.
  3470. EatExpSign:    mov    al, es:[di]
  3471.         inc    di
  3472. ExpNotNeg:    xor    bp, bp
  3473. ExpDigits:      sub    al, '0'
  3474.         cmp    al, 10
  3475.         jae    EndOfExponent
  3476.         shl    bp, 1
  3477.         mov    TempExp, bp
  3478.         shl    bp, 1
  3479.         shl    bp, 1
  3480.         add    bp, TempExp
  3481.         add    bp, ax
  3482.         mov    al, es:[di]
  3483.         inc    di
  3484.         jmp    ExpDigits
  3485. ;
  3486. EndOfExponent:    cmp    ExpSign, 0
  3487.         je    PosExp
  3488.         neg    bp
  3489. PosExp:        add    DecExponent, bp
  3490. ;
  3491. ; Normalize the number here:
  3492. ;
  3493. NormalizeInput:    mov    ax, si            ;See if they entered zero.
  3494.         or    ax, bx
  3495.         or    ax, cx
  3496.         or    ax, dx
  3497.         jnz    ItsNotZero
  3498.         jmp    ItsZero
  3499. ;
  3500. ItsNotZero:    mov    ax, si
  3501.         mov    si, 7fffh+63        ;Exponent if already nrm'd.
  3502. NrmInp16:    or    ax, ax            ;See if we can shift 16 bits.
  3503.         jnz    NrmInp8
  3504.         mov    ax, dx
  3505.         mov    dx, cx
  3506.         mov    cx, bx
  3507.         xor    bx, bx
  3508.         sub    si, 16
  3509.         jmp    NrmInp16
  3510. ;
  3511. NrmInp8:    cmp    ah, 0
  3512.         jne    NrmInp1
  3513.         mov    ah, al
  3514.         mov    al, dh
  3515.         mov    dh, dl
  3516.         mov    dl, ch
  3517.         mov    ch, cl
  3518.         mov    cl, bh
  3519.         mov    bh, bl
  3520.         mov    bl, 0
  3521.         sub    si, 8
  3522. ;
  3523. NrmInp1:    cmp    ah, 80h
  3524.         jae    NrmDone
  3525.         shl    bx, 1
  3526.         rcl    cx, 1
  3527.         rcl    dx, 1
  3528.         rcl    ax, 1
  3529.         dec    si
  3530.         jmp    NrmInp1
  3531. ;
  3532. ; Okay, the number is normalized.  Now multiply by 10 the number of times
  3533. ; specified in DecExponent.  Obviously, this uses the power of ten tables
  3534. ; to speed up this operation (and make it more accurate).
  3535. ;
  3536. NrmDone:    mov    fpacc.Exponent, si    ;Save away the value so far.
  3537.         mov    fpacc.Mantissa [0], bx
  3538.         mov    fpacc.Mantissa [2], cx
  3539.         mov    fpacc.Mantissa [4], dx
  3540.         mov    fpacc.Mantissa [6], ax
  3541. ;
  3542.         mov    bx, -13            ;Index into POT table.
  3543.         mov    si, DecExponent
  3544.         or    si, si            ;See if negative
  3545.         js    NegExpLp
  3546. ;
  3547. ; Okay, the exponent is positive, handle that down here.
  3548. ;
  3549. PosExpLp:    add    bx, 13            ;Find the 1st power of ten
  3550.         cmp    si, PotTblP [bx] + 11    ; in the table which is
  3551.         jb    PosExpLp        ; just less than this guy.
  3552.         cmp    PotTblP [bx] + 8, 7fffh    ;Hit 1.0 yet?
  3553.         je    MulExpDone
  3554. ;
  3555.         sub    si, PotTblP [bx] + 11    ;Fix for the next time through.
  3556.         call    PTbl2FPOP        ;Load up current power of ten.
  3557.         call    sl_FMUL            ;Multiply by this guy.
  3558.         jmp    PosExpLp
  3559. ;
  3560. ;
  3561. ; Okay, the exponent is negative, handle that down here.
  3562. ;
  3563. NegExpLp:    add    bx, 13            ;Find the 1st power of ten
  3564.         cmp    si, PotTblN [bx] + 11    ; in the table which is
  3565.         jg    NegExpLp        ; just less than this guy.
  3566.         cmp    PotTblN [bx] + 8, 7fffh    ;Hit 1.0 yet?
  3567.         je    MulExpDone
  3568. ;
  3569.         sub    si, PotTblN [bx] + 11    ;Fix for the next time through.
  3570.         call    NTbl2FPOP        ;Load up current power of ten.
  3571.         call    sl_FMUL            ;Multiply by this guy.
  3572.         jmp    NegExpLp
  3573. ;
  3574. ; If the user entered zero, drop down here and zero out fpacc.
  3575. ;
  3576. ItsZero:    xor    ax, ax
  3577.         mov    fpacc.Exponent, ax
  3578.         mov    fpacc.Sign, al
  3579.         mov    fpacc.Mantissa [0], ax
  3580.         mov    fpacc.Mantissa [2], ax
  3581.         mov    fpacc.Mantissa [4], ax
  3582.         mov    fpacc.Mantissa [6], ax
  3583. ;
  3584. ; Round the result to produce a *halfway* decent number
  3585. ;
  3586. MulExpDone:     cmp    fpacc.Exponent, 0ffffh        ;Don't round if too big.
  3587.         je    atofDone
  3588.         shl    byte ptr fpacc.Mantissa, 1    ;Use L.O. bits as guard
  3589.         adc    byte ptr fpacc.Mantissa [1], 0    ; bits.
  3590.         jnc    atofDone
  3591.         inc    fpacc.Mantissa[2]
  3592.         jne    atofDone
  3593.         inc    fpacc.Mantissa[4]
  3594.         jne    atofDone
  3595.         inc    fpacc.Mantissa[6]
  3596.         jne    atofDone
  3597.         inc    fpacc.Exponent
  3598. ;
  3599. atofDone:    mov    byte ptr fpacc.Mantissa, 0
  3600.         pop    bp
  3601.         pop    di
  3602.         pop    si
  3603.         pop    dx
  3604.         pop    cx
  3605.         pop    bx
  3606.         pop    ax
  3607.         pop    ds
  3608.         ret
  3609. sl_ATOF        endp
  3610. ;
  3611. ;
  3612. stdlib        ends
  3613.         end
  3614.